home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
095
/
131abas.arc
/
RBBS-PC.BAS
< prev
Wrap
BASIC Source File
|
1985-12-01
|
219KB
|
6,250 lines
3 ' $linesize: 132
4 ' $title: 'RBBS CPC13-1A, Copyright 1985 by D. Thomas Mack'
5 ' WARNING !!! DO NOT CHANGE, BYPASS OR REMOVE LINES 3-65
9 'by D. Thomas Mack & Jon J. Martin
10 ' The Second Ring Aircomm
11 ' 10210 Oxfordshire Road 4396 N. Prairie Willow Ct.
12 ' Great Falls, Virginia 22066 Concord, California 94521
13 '
14 ' *******************************NOTICE*************************************
15 ' * A limited license is granted to all users of this program and it's *
16 ' * companion program, CONFIG (version 1.9), to make copies of this *
17 ' * program and distribute the copies to other users, on the following *
18 ' * conditions: *
19 ' * 1. The notices contained in lines 3 through 59 of the program *
20 ' * are not altered, bypassed, or removed. *
21 ' * 2. The program is not to be disrtibuted to others in modified *
22 ' * form (i.e. the line numbers must remain the same). *
23 ' * 3. No fee is to be charged (or any other consideration received) *
24 ' * for coping or distributing these programs without an express *
25 ' * written agreement with D. Thomas Mack, The Second Ring, 10210 *
26 ' * Oxfordshire Road, Great falls, Virginia 22006 *
27 ' * *
28 ' * Copyright (c) 1983, 1984, 1985 D. Thomas Mack, The Second Ring *
29 ' **************************************************************************
30 DEFINT A-Z
31 WIDTH 80
32 CLS
34 KEY OFF
35 LOCATE ,,0
36 PRINT TAB(60)"tm"
37 PRINT TAB(16) STRING$(15,205)" U S E R W A R E " STRING$(15,205)
38 PRINT
39 PRINT TAB(17)"Capital PC User Group User-Supported Software"
40 PRINT
41 PRINT TAB(5) CHR$(214) STRING$(66,196) CHR$(183)
42 FOR I = 1 TO 12
43 READ A$
44 PRINT TAB(5) CHR$(186);A$; SPACE$(66 - LEN(A$)); CHR$(186)
45 NEXT
46 PRINT TAB(5) CHR$(211) STRING$(66,196) CHR$(189)
47 PRINT TAB(21)"Copyright (c) 1983, 1984, 1985 Tom Mack, 10210 Oxfordshire Rd., Great Falls, VA"
48 DATA " If you are using RBBS-PC CPC13.1 and find it valuable, I"
49 DATA " suggest you consider a contribution to"
50 DATA ""
51 DATA " Capital PC Software Exchange"
52 DATA " Post Office Box 6128"
53 DATA " Silver Spring, Maryland 20906"
54 DATA ""
55 DATA " You are free to copy and share RBBS-PC CPC13.1 with"
56 DATA " others on these three conditions:"
57 DATA " 1. This program is not distributed in modified form."
58 DATA " 2. No fee or consideration is charged for RBBS-PC, itself."
59 DATA " 3. This notice is not bypassed or removed."
63 GOSUB 50510
65 GOSUB 50510
100 CLEAR:' Erase all variables
ON ERROR GOTO 13000:' Set ERROR trap
DEF SEG:' Point to BASIC
CLS:' Clear Screen
WIDTH 80:' Set Screen Width
SCREEN 0,0,0:' Text, No color, Pg 0
KEY OFF:' Line 25 turned off
DEFINT A-Z:' All var. integer
DIM A$(30):' Message line table
DIM B$(128):' Message line edits
DIM FILES.FUNCTION(10):' Files menu security
DIM HELP$(9):' Help file names
DIM LG$(11):' 21 Work variables.
DIM M(250,2):' Message pointers
DIM MAIN.FUNCTION(21):' Main menu security
DIM MENU$(6):' Menu file names
DIM SYSOP.FUNCTION.KEY$(11):' Sysop Function keys
DIM SUBDIR$(99):' Download Sub-Dirs
DIM SYSOP.FUNCTION(7):' Sysop menu security
DIM UTILITY.FUNCTION(16):' Utility menu security
' ********************* Variable Definitions ********************************
ACKNOWLEDGE$ = CHR$(6)
ACTIVE.MESSAGE$=CHR$(225)
BACKSPACE$ = CHR$(8) + CHR$(32) + CHR$(8)
BACK.ARROW$ = CHR$(29) + CHR$(32) + CHR$(29)
CANCEL$ = CHR$(24)
COLOR.RESET$=CHR$(27)+"[00;33;40M"
CONFIG.FILENAME$ = "RBBS-PC.DEF"
CARRIAGE.RETURN$ = CHR$(13)
DELETED.MESSAGE$=CHR$(226)
END.TRANSMISSION$ = CHR$(4)
ESCAPE$ = CHR$(27)
FALSE = 0:' Set FALSE condition
F1.KEY = 59
F10.KEY = 68
LINE.FEED$ = CHR$(10)
LINE.FEEDS = NOT FALSE
LOCK.STATUS$ = "UM UU UB UD"
NEGATIVE.ACKNOWLEDGE$ = CHR$(21)
OMNINET = 2:'
RIGHT.MARGIN = 72
RETURN.LINE.FEED$ = CARRIAGE.RETURN$ + LINE.FEED$
START.OF.HEADER$ = CHR$(1)
TIME.LOGGED.ON$ = SPACE$(8)
TRANSFER.OPTIONS$=" type <A)scii, <M>NP, <X>modem, <C>Xmodem/CRC, <Q>uit"
TRUE = NOT FALSE:' Set TRUE condition
VERSION.ID$ = "CPC13.1A"
XOFF$ = CHR$(19)
XON$ = CHR$(17)
' ******************** Logon Error Message Table ****************************
LG$(1) = "Registration Check Failed"
LG$(2) = "Sysop name attempted"
LG$(3) = "Locked out attempt"
LG$(4) = "Password Attempt Failed"
LG$(5) = "Auto Lockout done"
LG$(6) = "Name in use on another Node! "
LG$(7) = "300 Baud access not allowed!"
' ***************** Predefined Function Definitions *************************
' --- Convert 2 byte string to Integer
DEF FN V(A1$,A) = VAL(MID$(A1$,A,2))
' --- Create network Block Lock Semaphore
DEF FN BL$ = "BLK" + RIGHT$("0000" + MID$(STR$(BLK),2),5)
' --- Test byte for specific bit turned on
DEF FN BT(Y,X) = (Y AND X) > 0
' --- Convert MM/DD/YY to 3 byte field Chr$(YY) + Chr$(MM) + Chr$(DD)
DEF FN CD$(A1$) = CHR$(FN V(A1$,7)) + CHR$(FN V(A1$,1)) + CHR$(FN V(A1$,4))
' --- Create YYMMDD string from MM/DD/YY string
DEF FN DC$(A1$) = RIGHT$(A1$,2) + LEFT$(A1$,2) + MID$(A1$,4,2)
' --- Remove leading spaces from string field
DEF FN RS$(A1$)
WHILE LEFT$(A1$,1) = " "
A1$ = MID$(A1$,2)
WEND
FN RS$ = A1$
END DEF
' --- Force Variable to specific length with spaces on right end
DEF FN S$(A1$,A) = A1$ + SPACE$(A-LEN(A1$))
' --- Remove trailing spaces from string field
DEF FN SS$(A1$) = LEFT$(A1$ + SPACE$(2),INSTR(A1$ + SPACE$(2),SPACE$(2))-1)
' --- Calculate seconds since midnight
DEF FN TI! = VAL(RIGHT$(TIME$,2)) + _
VAL(RIGHT$(TIME$,5)) * 60 + _
VAL(RIGHT$(TIME$,8)) * 3600
' --- Convert lower to UPPER case
DEF FN UC$(CONVERT.FIELD$)
FOR Z = 1 TO LEN(CONVERT.FIELD$)
IF MID$(CONVERT.FIELD$,Z,1) > "@" THEN _
MID$(CONVERT.FIELD$,Z,1) = CHR$(ASC(MID$(CONVERT.FIELD$,Z,1)) AND 223)
NEXT
FN UC$=CONVERT.FIELD$
END DEF
' --- Convert 3 byte field Chr$(YY) + Chr$(MM) + Chr$(DD) to MM/DD/YY string
DEF FN UD$(A1$) = RIGHT$(STR$(ASC(MID$(A1$,2))),2) + _
"/" + _
RIGHT$(STR$(ASC(MID$(A1$,3))),2) + _
"/" + _
RIGHT$(STR$(ASC(A1$)),2)
'
' *****************************************************************************
' * GET NODE ID FROM COMMAND LINE *
' *****************************************************************************
'
PM$ = COMMAND$
IF LEN(PM$) = 0 THEN _
PM$ = "-"
NODE.RECORD.INDEX = INSTR("-1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ",LEFT$(PM$,1))
IF NODE.RECORD.INDEX < 2 THEN _
NODE.RECORD.INDEX = 2 : _
MID$(CONFIG.FILENAME$,5,1) = "-" : _
NODE.ID$ = "1" : _
GO TO 117
NODE.ID$ = STR$(NODE.RECORD.INDEX-1)
MID$(CONFIG.FILENAME$,5,1) = PM$
'
' *****************************************************************************
' * OPEN AND READ RBBS-PC CONFIGURATION DEFINITIONS *
' *****************************************************************************
'
117 OPEN "I",2,CONFIG.FILENAME$
INPUT #2,DOWNLOAD.DRIVES$, _
SYSOP.PASSWORD.1$, _
SYSOP.PASSWORD.2$, _
SYSOP.FIRST.NAME$, _
SYSOP.LAST.NAME$, _
REQUIRED.RINGS, _
START.OFFICE.HOURS, _
END.OFFICE.HOURS, _
MINUTES.PER.SESSION!, _
DF, _
DF, _
UPLOAD.DIRECTORY$, _
EXPERT.USER, _
ACTIVE.BULLETINS, _
PROMPT.BELL, _
DF, _
DF, _
MENU$(1), _
MENU$(2), _
MENU$(3), _
MENU$(4), _
MENU$(5), _
CONFERENCE.MENU$, _
DF, _
WELCOME.INTERRUPTABLE, _
REMIND.FILE.TRANSFERS, _
PAGE.LENGTH, _
MAX.MESSAGE.LINES, _
DOORS.AVAILABLE, _
DF$
INPUT #2,MAIN.MESSAGE.FILE$, _
MAIN.MESSAGE.BACKUP$, _
CALLERS.FILE$, _
COMMENTS.FILE$, _
MAIN.USER.FILE$, _
WELCOME.FILE$, _
NEWUSER.FILE$, _
DIRECTORY.EXTENTION$, _
COM.PORT$, _
BULLETINS.OPTIONAL, _
MODEM.INIT.COMMAND$, _
DF$, _
DOS.VERSION, _
FG, _
BG, _
BORDER, _
RBBS.BAT$, _
RCTTY.BAT$
118 INPUT #2,OMIT.MAIN.DIRECTORY$, _
OMIT.UPLOAD.DIRECTORY$, _
HELP$(1), _
HELP$(2), _
HELP$(3), _
HELP$(4), _
HELP$(5), _
HELP$(6), _
HELP$(7), _
HELP$(8), _
HELP$(9), _
BULLETIN.MENU$, _
BULLETIN.PREFIX$, _
DF$, _
MESSAGE.REMINDER, _
REQUIRE.NON.ASCII, _
DOORS.SECURITY.LEVEL, _
MAXIUM.NUMBER.OF.NODES, _
NETWORK.TYPE, _
RECYCLE.TO.DOS, _
DF, _
DF!, _
TRASHCAN.FILE$
INPUT #2,MINIMUM.LOGON.SECURITY, _
DEFAULT.SECURITY.LEVEL, _
SYSOP.SECURITY.LEVEL, _
FILESEC.FILE$, _
SYSOP.MENU.SECURITY.LEVEL, _
LOCAL.PASSWORD$, _
MAXIMUM.VIOLATIONS, _
SYSOP.FUNCTION(1), _
SYSOP.FUNCTION(2), _
SYSOP.FUNCTION(3), _
SYSOP.FUNCTION(4), _
SYSOP.FUNCTION(5), _
SYSOP.FUNCTION(6), _
SYSOP.FUNCTION(7), _
PASSWORDS.FILE$, _
MAXIMUM.PASSWORD.CHANGES, _
MINIMUM.SECURITY.FOR.TEMP.PASSWORD, _
OVERWRITE.SECURITY.LEVEL, _
DOORS.TERMINAL.TYPE, _
LIMIT.DAILY.TIME
119 INPUT #2,MAIN.FUNCTION(1), _
MAIN.FUNCTION(2), _
MAIN.FUNCTION(3), _
MAIN.FUNCTION(4), _
MAIN.FUNCTION(5), _
MAIN.FUNCTION(6), _
MAIN.FUNCTION(7), _
MAIN.FUNCTION(8), _
MAIN.FUNCTION(9), _
MAIN.FUNCTION(10), _
MAIN.FUNCTION(11), _
MAIN.FUNCTION(12), _
MAIN.FUNCTION(13), _
MAIN.FUNCTION(14), _
MAIN.FUNCTION(15), _
MAIN.FUNCTION(16), _
MAIN.FUNCTION(17), _
MAIN.FUNCTION(18), _
MAIN.FUNCTION(19), _
MAIN.FUNCTION(20), _
MAIN.FUNCTION(21), _
DEFAULT.MACHINE.TYPE$, _
WAIT.BEFORE.DISCONNECT
121 INPUT #2,FILES.FUNCTION(1), _
FILES.FUNCTION(2), _
FILES.FUNCTION(3), _
FILES.FUNCTION(4), _
FILES.FUNCTION(5), _
FILES.FUNCTION(6), _
FILES.FUNCTION(7), _
FILES.FUNCTION(8), _
FILES.FUNCTION(9), _
FILES.FUNCTION(10), _
UTILITY.FUNCTION(1), _
UTILITY.FUNCTION(2), _
UTILITY.FUNCTION(3), _
UTILITY.FUNCTION(4), _
UTILITY.FUNCTION(5), _
UTILITY.FUNCTION(6), _
UTILITY.FUNCTION(7), _
UTILITY.FUNCTION(8), _
UTILITY.FUNCTION(9), _
UTILITY.FUNCTION(10), _
UTILITY.FUNCTION(11), _
UTILITY.FUNCTION(12), _
UTILITY.FUNCTION(13), _
UTILITY.FUNCTION(14), _
UTILITY.FUNCTION(15), _
UTILITY.FUNCTION(16), _
UPLOAD.TIME.FACTOR!, _
COMPUTER.TYPE, _
REMIND.PROFILE, _
RBBS.NAME$, _
COMMANDS.BETWEEN.RINGS, _
MNP.SUPPORT, _
PAGING.PRINTER.SUPPORT$, _
MODEM.INIT.BAUD$
FOR FUNCTION.KEY.INDEX = 1 TO 11
INPUT #2,SYSOP.FUNCTION.KEY$(FUNCTION.KEY.INDEX)
NEXT
'
' *****************************************************************************
' * ESTABLISH COMMUNICATION PORT REGISTERS AND COMMANDS *
' * GET DOS SUB-DIRECTORY RBBS-PC OPTIONS *
' *****************************************************************************
'
122 INPUT #2, DF,_
SUBDIR.COUNT,_
DF,_
UPLOAD.TO.SUBDIR,_
DF,_
UPLOAD.SUBDIR$,_
RESTRICT.BAUD,_
USE.COLOR,_
DISKFULL.GO.OFFLINE,_
EXTENDED.LOGGING,_
MODEM.RESET.COMMAND$,_
MODEM.COUNT.RINGS.COMMAND$,_
MODEM.ANSWER.COMMAND$,_
MODEM.GO.OFFHOOK.COMMAND$,_
DISK.FOR.DOS$, _
DUMB.MODEM, _
LSB,_
MSB,_
LINE.CONTROL.REGISTER,_
MODEM.CONTROL.REGISTER,_
LINE.STATUS.REGISTER,_
MODEM.STATUS.REGISTER
'
' *****************************************************************************
' * ESTABLISH RBBS-PC'S DOS SUBDIRECTORIES USAGE *
' *****************************************************************************
'
IF SUBDIR.COUNT<1 THEN _
GOTO 123
FOR SUBDIR.INDEX = 1 TO SUBDIR.COUNT
INPUT #2,SUBDIR$
SUBDIR$(SUBDIR.INDEX) = SUBDIR$ + "\"
NEXT
GOTO 125
'
' *****************************************************************************
' * SETUP DOWNLOAD DRIVES WITH NO SUBDIRECTORY SUPPORT *
' *****************************************************************************
'
123 FOR SUBDIR.INDEX = 1 TO LEN(DOWNLOAD.DRIVES$) - 1
SUBDIR$(SUBDIR.INDEX) = MID$(DOWNLOAD.DRIVES$,SUBDIR.INDEX,1) + ":"
NEXT
SUBDIR.COUNT = LEN(DOWNLOAD.DRIVES$) - 1
'
' *****************************************************************************
' * SETUP UPLOAD DRIVE AND DIRECTORY.NAME *
' *****************************************************************************
'
125 UPLOAD.DIR.CHECK$ = FN S$(UPLOAD.DIRECTORY$,8)
SUBDIR.COUNT = SUBDIR.COUNT + 1
IF UPLOAD.TO.SUBDIR THEN _
SUBDIR$(SUBDIR.COUNT) = UPLOAD.SUBDIR$ + "\" _
ELSE SUBDIR$(SUBDIR.COUNT) = RIGHT$(DOWNLOAD.DRIVES$,1) + _
":"
UPLOAD.DIRECTORY$ = SUBDIR$(SUBDIR.COUNT) + _
UPLOAD.DIRECTORY$ + _
"." + _
DIRECTORY.EXTENTION$
'
' *****************************************************************************
' * INITIALIZE OMNINET INTERFACE IF OMNINET IN USE *
' *****************************************************************************
'
128 IF NETWORK.TYPE = OMNINET THEN _
CN$ = SPACE$(535) : _
CALL INITIO(A)
'
' *****************************************************************************
' * ESTABLISH NEXT CALLERS FILE RECORD AVAILABLE *
' *****************************************************************************
'
GOSUB 56000
CALLERS.FILE.INDEX = LOF(4) / 64
130 GET 4,CALLERS.FILE.INDEX
IF LEFT$(CALLERS.RECORD$,13) = STRING$(13,0) THEN _
CALLERS.FILE.INDEX = CALLERS.FILE.INDEX-1 : _
GOTO 130
'
' *****************************************************************************
' * TEST FOR MESSAGE FILE PRESENT (ABORT IF NOT PRESENT) *
' *****************************************************************************
'
135 ACTIVE.MESSAGE.FILE$ = MAIN.MESSAGE.FILE$
ACTIVE.USER.FILE$ = MAIN.USER.FILE$
GOSUB 4910
GET 1,NODE.RECORD.INDEX
MID$(MESSAGE.RECORD$,57,1)="I"
PUT 1,NODE.RECORD.INDEX
GOSUB 21996
'
' *****************************************************************************
' * TEST FOR COLOR GRAPHICS MONITOR AND ANSI.SYS SUPPORT TO ALLOW THE LOCAL *
' * SYSOP TO SEE THE SAME COLOR MENUS AND SCREENS THAT THE REMOTE USER SEES *
' *****************************************************************************
'
DEF SEG = 0
IF (PEEK(&H410) AND &H30) <> &H30 AND _
USE.COLOR THEN _
COLOR.SUPPORT = TRUE : _
A$ = COLOR.RESET$ : _
LOCAL.USER = TRUE : _
GOSUB 1405 : _
LOCAL.USER = FALSE
'
' *****************************************************************************
' * TEST FOR MULTI LINK PRESENT IF NOT COMPAQ COMPUTER *
' *****************************************************************************
'
IF COMPUTER.TYPE <> 1 THEN _
MULTI.LINK.PRESENT = PEEK(&H1FE) + 256*PEEK(&H1FF) : _
IF MULTI.LINK.PRESENT > 0 THEN _
DEF SEG = MULTI.LINK.PRESENT : _
MULTI.LINK.COM.PORT = (&H64 + PEEK(&H58) + 256*PEEK(&H59) + &HC) : _
IF PEEK(MULTI.LINK.COM.PORT) = &H1 OR &H2 THEN _
POKE (MULTI.LINK.COM.PORT),&H9
'
' *****************************************************************************
' * RESET MULTI LINK SPECIAL PARAMETERS TO NORMAL (NOT EXIT TO DOORS) *
' *****************************************************************************
'
DEF SEG
IF MULTI.LINK.PRESENT THEN _
AX = &HB00 : _ ' Turn off ML's carrier monitoring.
BX = 0 : _
GOSUB 60510 : _
AX = &H701 : _ ' Change terminal type to ML type 1.
BX = 0 : _
GOSUB 60510 : _
AX = &H1 : _ ' Conditionally enque on comm. port
GOSUB 60505
IF NOT MNP.SUPPORT THEN _
TRANSFER.OPTIONS$ = MID$(TRANSFER.OPTIONS$,1,14) + _
MID$(TRANSFER.OPTIONS$,22)
'
' *****************************************************************************
' * DISPLAY RBBS-PC MAIN FUNCTION KEY DISPLAY *
' *****************************************************************************
'
170 PRINT "RBBS-PC VERSION ";VERSION.ID$;" Node ";NODE.ID$
PRINT "Free memory: "; FRE("A")
PRINT
PRINT"Press:"
FOR FUNCTION.KEY.INDEX = 1 TO 11
PRINT SYSOP.FUNCTION.KEY$(FUNCTION.KEY.INDEX)
IF FUNCTION.KEY.INDEX < 11 THEN _
KEY FUNCTION.KEY.INDEX,""
NEXT
'
' *****************************************************************************
' * IF RUNNING MORE THAN ONE NODE IN A DOS 3.X ENVIRONMENT (OR HIGHER) UNDER *
' * MULTILINK, THEN SET THE "SHARE.IT" INDICATOR ON SO THAT ALL FILES CAN BE *
' * ACCESSED BY ALL PARTITIONS IN A MULTI-TASKING ENVIRONMENT (I.E. MULTI- *
' * LINK). *
' *****************************************************************************
'
IF DOS.VERSION > 2 AND _
MAXIMUM.NUMBER.OF.NODES > 1 AND _
MULTI.LINK.PRESENT THEN _
SHARE.IT = TRUE
'
' *****************************************************************************
' * GET CURRENT STATUS OF SYSOP AVAIL, SYSOP ANNOY, SYSOP NEXT, & PRINTER *
' *****************************************************************************
'
175 GOSUB 30500
GET 1,NODE.RECORD.INDEX
SYSOP.AVAILABLE = FN V(MESSAGE.RECORD$,32)
SYSOP.ANNOY = FN V(MESSAGE.RECORD$,34)
SYSOP.NEXT = FN V(MESSAGE.RECORD$,36)
PRINTER = FN V(MESSAGE.RECORD$,38)
EXIT.TO.DOORS = FN V(MESSAGE.RECORD$,40)
SNOOP = FN V(MESSAGE.RECORD$,58)
GOSUB 950
'
' *****************************************************************************
' * INITIALIZE MODEM AND ANNOUNCE RBBS-PC IS UP AND READY FOR CALLS *
' *****************************************************************************
'
200 IF INP(MODEM.STATUS.REGISTER) < 128 THEN _
OUT MODEM.CONTROL.REGISTER,&H4 : _
GOSUB 50500 : _
OUT MODEM.CONTROL.REGISTER,&H0
210 OPEN COM.PORT$ + ":" + MODEM.INIT.BAUD$ + ",N,8,1,RS,CD,DS" AS #3
220 GOSUB 41500
230 IF PRINTER THEN _
LPRINT "RBBS-PC VERSION ";VERSION.ID$;" Node ";NODE.ID$;" up at ";TIM$;" on "; DATE$
235 EIGHT.BIT = TRUE
IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
GOSUB 44000 : _
GOTO 410
A$ = MODEM.RESET.COMMAND$
GOSUB 52070
IF COMPUTER.TYPE = 2 AND COM.PORT$ = "COM1" AND MODEM.STATUS.REGISTER = 1022 THEN _
FOR I = 1 TO 3 : _
GOSUB 50510 : _
NEXT
GOSUB 50510
A$ = MODEM.INIT.COMMAND$
GOSUB 52070
PRINT
PRINT "READY FOR CALLS AT ";TIM$;" ON "; DATE$
PRINT
PRINT "<SCREEN CLEARS TO PREVENT BURN IN>"
PRINT
IF RESTRICT.BAUD THEN _
PRINT "300 BAUD NOT ALLOWED ";
IF COLOR.SUPPORT THEN _
PRINT "ANSI COLOR SUPPORT ACTIVE ";
IF EXTENDED.LOGGING THEN _
PRINT "EXTENDED CALLER LOGGING"
PRINT
IF REQUIRED.RINGS = 0 THEN PRINT "WAITING FOR CARRIER"
IF REQUIRED.RINGS = 255 THEN PRINT "RING BACK SYSTEM SPECIFIED"
IF REQUIRED.RINGS > 0 AND _
REQUIRED.RINGS < 255 THEN _
PRINT "WAITING FOR RING ";REQUIRED.RINGS
'
' *****************************************************************************
' * GET READY TO ANSWER INCOMMING CALL: *
' * 1. LET THE MODEM "AUTO-ANSWER" FOR RBBS-PC. *
' * REQUIRED RINGS = 0 AND S0 = 1 IN MODEM INIT COMMAND. *
' * 2. ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS. *
' * REQUIRED RINGS > 0 AND S0 = 0 IN MODEM INIT COMMAND. *
' * 3. ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS AFTER A USER *
' * FIRST CALLS AND THEN HANGS UP (I.E. RING-BACK). *
' * REQUIRED RINGS > 0 AND S0 = 255 IN MODEM INIT COMMAND. *
' *****************************************************************************
'
TCA! = FN TI!
GOSUB 49000
QQ = 255
I = INSTR(MODEM.INIT.COMMAND$,"S0")
IF I = 0 THEN _
GOTO 239
IF VAL(MID$(MODEM.INIT.COMMAND$,I+3,3)) = 255 THEN _
QQ = 0 : _
BLK = QQ
239 RINGBACK.WAIT.STARTED! = 0
IF REQUIRED.RINGS > 0 AND QQ=0 THEN _
RINGBACK.WAIT.STARTED! = FN TI! : _
COLOR 7,0,0 _
ELSE COLOR FG,BG,BORDER
240 IF SYSOP.NEXT THEN _
GOTO 826
X = 1
'
' *****************************************************************************
' * WAIT FOR INCOMING CALLS *
' *****************************************************************************
'
WHILE INP(MODEM.STATUS.REGISTER) < 128
GOSUB 60000
250 IF KEY.PRESSED$ = ESCAPE$ THEN _
GOTO 826
260 IF RINGBACK.WAIT.STARTED! > 0 THEN _
IF FN TI! - RINGBACK.WAIT.STARTED! > 45 THEN _
RINGBACK.WAIT.STARTED! = 0 : _
RING.BACK.COUNT = 0 : _
Q = 0 : _
IF (SNOOP AND REQUIRED.RINGS) THEN _
PRINT "Ringback timeout";PAGING.PRINTER.SUPPORT$ : _
IF BLK THEN _
QQ = 0 _
ELSE QQ = 255
265 IF FN TI! - TCA! > 120 THEN _
LOCATE ,,0 : _
CLS : _
TCA! = FN TI!
266 IF (INP(MODEM.STATUS.REGISTER) AND &H40) > 0 AND _
REQUIRED.RINGS > 0 THEN _
GOTO 275
270 WEND
IF REQUIRED.RINGS = 0 THEN _
GOTO 321
'
' *****************************************************************************
' * PREPARE TO ANSWER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 0) OR *
' * THE CALL AFTER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 255) -- *
' * "RING BACK." *
' *****************************************************************************
'
275 IF LOC(3) THEN _
X$ = INPUT$(LOC(3),3)
A$ = MODEM.COUNT.RINGS.COMMAND$
GOSUB 52070
GOSUB 50500
290 X$ = INPUT$(LOC(3),3)
IF LEN(X$) = 0 THEN _
X$=STR$(RING.BACK.COUNT)
A$ = ""
IF QQ = 0 AND Q < VAL(X$) THEN _
Q = VAL(X$) : _
GOTO 305
300 RING.BACK.COUNT = RING.BACK.COUNT + 1
A$ = STR$(RING.BACK.COUNT)
IF QQ = 0 THEN _
RING.BACK.COUNT = VAL(X$) : _
A$ = STR$(RING.BACK.COUNT)
305 IF SNOOP THEN _
PRINT TIME$ + " Ring " + A$ + PAGING.PRINTER.SUPPORT$
310 IF RING.BACK.COUNT < REQUIRED.RINGS THEN _
GOTO 239
320 A$ = MODEM.ANSWER.COMMAND$
GOSUB 52070
'
' *****************************************************************************
' * TEST FOR CARRIER PRESENT *
' *****************************************************************************
'
321 CONNECT.DELAY! = FN TI! + 30
MODEM.RESPONSE$ = ""
322 IF INP(MODEM.STATUS.REGISTER) < 128 AND _
FN TI! < CONNECT.DELAY! THEN _
GOTO 322
IF INP(MODEM.STATUS.REGISTER) < 128 THEN _
GOTO 10595
GOSUB 50510
324 MODEM.RESPONSE$ = MODEM.RESPONSE$ + INPUT$(LOC(3),3)
PRINT MODEM.RESPONSE$
IF FN TI! > CONNECT.DELAY! THEN _
Z$ = "Connect timeout" : _
GOSUB 13665 : _
GOTO 10595
325 IF DUMB.MODEM THEN _
BAUD.TEST = VAL(MODEM.INIT.BAUD$) : _
GOTO 330
IF INSTR(MODEM.RESPONSE$,"CONNECT") THEN _
BAUD.TEST = VAL(MID$(MODEM.RESPONSE$,INSTR(MODEM.RESPONSE$,"CONNECT") + 8,4)) : _
GOTO 330
GOTO 324
'
' *****************************************************************************
' * DETERMINE BAUD RATE *
' *****************************************************************************
'
330 GOSUB 21280
IF BAUD.TEST = 0 OR BAUD.TEST = 300 THEN _
BAUD.RATE.DIVISOR = &H180 : _
BPS = -1 : _
GOSUB 1654 _
ELSE IF BAUD.TEST = 1200 OR BAUD.TEST = 2400 THEN _
BPS = -2-(BAUD.TEST / 1200) : _
BAUD.RATE.DIVISOR = 48 * (BPS + 5) : _
GOSUB 1654 _
ELSE 324
'
' *****************************************************************************
' * DISPLAY WELCOME LINE *
' *****************************************************************************
'
345 GOSUB 41500
USER.LOGON.TIME! = FN TI!
TIME.LOGGED.ON$ = TIME$
A$ = "WELCOME TO " + RBBS.NAME$ + CARRIAGE.RETURN$
GOSUB 1399
TEST.PARITY = TRUE
FILE.NAME$ = LEFT$(WELCOME.FILE$,2) + "PRELOG"
346 NAME FILE.NAME$ AS FILE.NAME$
347 BYPASS.TIME.CHECK = TRUE
GOSUB 43030
GOSUB 6000
BYPASS.TIME.CHECK = FALSE
FF = FALSE
'
' *****************************************************************************
' * GET USER NAME *
' * C - COMMAND FROM NEWUSER REGISTER OPTIONS (CHANGE NAME OR ADDRESS) *
' *****************************************************************************
'
400 UPPER.CASE = FALSE
A1$ = "What is your "
GOSUB 12500
BAUD.PARITY$ = MID$(" 300 45012002400",(-4*BPS),4) + _
" BAUD," + _
MID$("N,8,1E,7,1",6 + 5*EIGHT.BIT,5)
IF FF THEN _
LOGON.ERROR.INDEX = 1 : _
GOTO 10620
IF RESTRICT.BAUD THEN _
IF BPS = -1 THEN _
LOGON.ERROR.INDEX = 7 : _
GOTO 10620
'
' *****************************************************************************
' * CHECK IF SAME USER ON ANOTHER NODE *
' *****************************************************************************
'
410 FOR NODE.INDEX = 2 TO NODES.IN.SYSTEM + 1
GET 1,NODE.INDEX
IF INSTR(MESSAGE.RECORD$,ACTIVE.USER.NAME$) THEN _
IF MID$(MESSAGE.RECORD$,57,1) = "A" THEN _
LOGON.ERROR.INDEX = 6 : _
LG$(6) = LG$(6) + LEFT$(MESSAGE.RECORD$,25) : _
GOTO 10620 _
ELSE A$ = "Welcome back, " + _
LEFT$(MESSAGE.RECORD$,INSTR(MESSAGE.RECORD$," ")-1) + _ 'CPC131AB
"!" : _
GOSUB 1399 : _
GOTO 430
420 NEXT
'
' *****************************************************************************
' * TEST FOR REMOTE SYSOP LOGGING ON *
' *****************************************************************************
'
430 GET 1,NODE.RECORD.INDEX
LL = (ACTIVE.USER.NAME$ = LEFT$(MESSAGE.RECORD$,LEN(ACTIVE.USER.NAME$)))
IF FIRST.NAME$ = SYSOP.PASSWORD.1$ AND _
LAST.NAME$ = SYSOP.PASSWORD.2$ THEN _
UPPER.CASE = FALSE : _
CI$ = "REMOTE" : _
GOTO 827
'
' *****************************************************************************
' * TEST FOR SYSOP NAME ATTEMPT *
' *****************************************************************************
'
445 IF INSTR(ACTIVE.USER.NAME$,"SYSOP") OR _
INSTR(ACTIVE.USER.NAME$,SYSOP.FIRST.NAME$ + " " + SYSOP.LAST.NAME$) THEN _
LOGON.ERROR.INDEX = 2 : _
GOTO 10620
'
' *****************************************************************************
' * REMOVE INVALID CHARACTERS FROM USER NAME *
' *****************************************************************************
'
455 FOR J = 1 TO LEN(ACTIVE.USER.NAME$)
X = ASC(MID$(ACTIVE.USER.NAME$,J,1))
IF (X < 65 OR X > 90) AND _
(X <> 32 AND X <> 39 AND X <> 45 AND X <> 46) THEN _
GOTO 400
465 NEXT
'
' *****************************************************************************
' * CHECK FOR ACTIVE USER *
' *****************************************************************************
'
TEMP.USER.NAME$ = ACTIVE.USER.NAME$
GOSUB 12600
IF NOT FOUND THEN _
GOTO 700
GOSUB 21995
'
' *****************************************************************************
' * ACTIVE USER FOUND *
' *****************************************************************************
'
GOSUB 9500
USER.FILE.INDEX = LOC(2)
IF USER.SECURITY.LEVEL < MINIMUM.LOGON.SECURITY THEN _
GOTO 725
GOSUB 26500
CI$ = CITY.STATE$
ATTEMPTS.ALLOWED = 4
PASSWORD.SAVE$ = PASSWORD$
MESSAGE.PASSWORD = FALSE
IF CURRENT.DATE$ <> LEFT$(LAST.DATE.TIME.ON$,8) THEN _
ELAPSED.TIME = 0 _
ELSE ELAPSED.TIME = CVI(ELAPSED.TIME$)
480 IF Q = 3 THEN _
Z$ = B$(3) : _
ATTEMPTS = 1 : _
GOSUB 677 _
ELSE GOSUB 675
630 IF PASSWORD.FAILED THEN _
LOGON.ERROR.INDEX = 4 : _
GOTO 10620
643 GOSUB 41070
NEW.USER = FALSE
LM$ = FN DC$(FN UD$(LIST.NEW.DATE$))
IF MID$(LM$,3,1) = " " THEN _
MID$(LM$,3,1) = "0"
655 IF MID$(LM$,5,1) = " " THEN _
MID$(LM$,5,1) = "0"
660 GOTO 800
'
' *****************************************************************************
' * USER & MESSAGE PASSWORD VALIDATION *
' *****************************************************************************
'
665 IF PASSWORD.SAVE$ = PASSWORD$ THEN _
PASSWORD.FAILED = 0 : _
RETURN
667 ATTEMPTS = 0
670 ATTEMPTS = ATTEMPTS + 1
IF ATTEMPTS > ATTEMPTS.ALLOWED THEN _
PASSWORD.FAILED = TRUE : _
RETURN
675 A$ = "Enter Password (dots will echo)"
GOSUB 45010
Z$ = B$(1)
677 IF LEN(Z$) > 15 THEN _
GOTO 680
Z$ = FN UC$(Z$)
Z$ = FN S$(Z$,15)
IF PASSWORD.SAVE$ = Z$ THEN _
PASSWORD.FAILED = 0 : _
RETURN
680 IF MESSAGE.PASSWORD THEN _
A$ = "Wrong password entered!" : _
GOSUB 1405
GOTO 670
'
' *****************************************************************************
' * ACTIVE USER NOT FOUND (NEWUSER ROUTINE) *
' *****************************************************************************
'
700 Z$ = FIRST.NAME$
GOSUB 12570
IF FOUND THEN _
GOSUB 21995 : _
GOTO 12595
Z$ = LAST.NAME$
GOSUB 12570
IF FOUND THEN _
GOSUB 21995 : _
GOTO 12595
710 IF USER.FILE.INDEX = 0 THEN _
GOTO 13540
720 NEW.USER = TRUE
GOSUB 9400
GOSUB 12630
LSET USER.NAME$ = "NEWUSER"
PUT 2,USER.FILE.INDEX
USER.SECURITY.LEVEL = DEFAULT.SECURITY.LEVEL
725 IF USER.SECURITY.LEVEL < MINIMUM.LOGON.SECURITY OR _
FIRST.NAME$ = LAST.NAME$ THEN _
LOGON.ERROR.INDEX = 3 : _
GOTO 10620
730 GOSUB 12950
USER.RECORD.SAVE$ = USER.RECORD$
BYPASS.TIME.CHECK = TRUE
FILE.NAME$ = NEWUSER.FILE$
STOP.INTERRUPTS = FALSE
GOSUB 1790
STOP.INTERRUPTS = TRUE
BYPASS.TIME.CHECK = FALSE
GOSUB 9400
LSET USER.RECORD$ = USER.RECORD.SAVE$
A$ = ACTIVE.USER.NAME$ + " from " + CITY.STATE$
GOSUB 1405
740 A$ = "<C>hange name/address, <D>isconnect (don't register), <R>egister"
GOSUB 1500
Z$ = FN UC$(B$(1))
S = INSTR("CDR",Z$)
745 ON S GOTO 747,750,755
GOTO 740
747 Z$ = ACTIVE.USER.NAME$ + " from " + CI$ + " changed Name/Address"
GOSUB 13670
LSET USER.NAME$ = STRING$(31,0)
PUT 2,USER.FILE.INDEX
GOSUB 27500
FF = FALSE
GOTO 400
'
' *****************************************************************************
' * D - COMMAND FROM NEWUSER ROUTINE (DISCONNECT - REFUSE TO REGISTER) *
' *****************************************************************************
'
750 Z$ = ACTIVE.USER.NAME$ + " of " + CI$ + " refused to register"
GOSUB 13670
LSET USER.NAME$ = STRING$(31,0)
PUT 2,USER.FILE.INDEX
GOSUB 27500
FF = FALSE
USER.FILE.INDEX = 0
GOTO 13540
'
' *****************************************************************************
' * R - COMMAND FROM NEWUSER ROUTINE (REGISTER) *
' *****************************************************************************
'
755 GOSUB 12800
A$ = "Re-enter PASSWORD for verification (Dots will Echo)"
GOSUB 45010
SWAP Z$,B$(1)
Z$ = FN UC$(Z$)
IF B$(1) <> Z$ THEN _
A$ = "Passwords Don't match!" : _
GOSUB 1405 : _
GOTO 755
760 Z$ = FN UC$(Z$)
LSET PASSWORD$ = Z$
A$ = "Please REMEMBER your password"
GOSUB 1399
TEMP.SECURITY.LEVEL = USER.SECURITY.LEVEL
GOSUB 42950
BYPASS.TIME.CHECK = TRUE
GOSUB 43000
BYPASS.TIME.CHECK = FALSE
GOSUB 43030
GOSUB 42800
GOSUB 42700
GOSUB 12900
RIGHT.MARGIN = 64
EXPERT.USER = FALSE
GOSUB 9600
'
' *****************************************************************************
' * LOGIN ALL USERS *
' *****************************************************************************
'
800 MAIN.USER.FILE.INDEX = USER.FILE.INDEX
USER.SECURITY.SAVE = USER.SECURITY.LEVEL
A$ = "Logging " + ACTIVE.USER.NAME$
GOSUB 1398
TIMES.LOGGED.ON = CVI(MID$(USER.OPTIONS$,1,2)) + 1
GOSUB 9500
A1$ = LAST.DATE.TIME.ON$
A$ = "RBBS-PC VERSION " + _
VERSION.ID$ + _
" NODE " + _
NODE.ID$ + _
RETURN.LINE.FEED$ + _
" OPERATING AT " + _
BAUD.PARITY$
ATTEMPTS = 0
GOSUB 1399
815 DOWNLOADS = CVI(USER.DOWNLOADS$)
UPLOADS = CVI(USER.UPLOADS$)
LAST.MESSAGE.READ = -LAST.MESSAGE.READ*(LAST.MESSAGE.READ <= HIGH.MESSAGE.NUMBER)
LSET USER.OPTIONS$ = MKI$(TIMES.LOGGED.ON) + _
MID$(USER.OPTIONS$,3)
LSET LAST.DATE.TIME.ON$ = CURRENT.DATE$ + " " + TIME.LOGGED.ON$
PUT 2,USER.FILE.INDEX
GOSUB 27500
IF NOT LL THEN _
STOP.INTERRUPTS = WELCOME.INTERRUPTABLE : _
BYPASS.TIME.CHECK = TRUE : _
FILE.NAME$ = WELCOME.FILE$ : _
GOSUB 43030 : _
GOSUB 6000 : _
BYPASS.TIME.CHECK = FALSE : _
STOP.INTERRUPTS = FALSE
816 IF NEW.USER THEN _
BYPASS.TIME.CHECK = TRUE : _
GOSUB 1700 : _
BYPASS.TIME.CHECK = FALSE _
ELSE A$ = "Times on:" + STR$(TIMES.LOGGED.ON) : _
GOSUB 1405 : _
A$ = "Last time on was: " + A1$ : _
GOSUB 1405
817 IF REMIND.FILE.TRANSFERS THEN _
A$ = "Files Downloaded:" + _
STR$(DOWNLOADS) + _
" Uploaded:" + _
STR$(UPLOADS) : _
GOSUB 1400
820 IF REMIND.PROFILE THEN _
GOSUB 5400
825 CI$ = FN SS$(CI$)
GOTO 830
'
' *****************************************************************************
' * ESC PRESSED ON LOCAL CONSOLE ENTERS HERE *
' *****************************************************************************
'
826 USER.LOGON.TIME! = FN TI!
GOSUB 14500
LOCAL.USER = TRUE
WAIT.BEFORE.DISCONNECT = 32400
IF LOCAL.PASSWORD$ <> "NONE" THEN _
LOCATE 24,1 : _
INPUT "Enter PASSWORD";Z$ : _
IF FN UC$(Z$) <> LOCAL.PASSWORD$ THEN _
GOTO 13549
EIGHT.BIT = TRUE
GR = 1
CI$ = "LOCAL"
LINE.FEEDS = TRUE
RETURN.LINE.FEED$ = LINE.FEED$
USER.SECURITY.LEVEL = SYSOP.SECURITY.LEVEL
827 FIRST.NAME$ = SYSOP.FIRST.NAME$
LAST.NAME$ = SYSOP.LAST.NAME$
ACTIVE.USER.NAME$ = "SYSOP"
USER.SECURITY.LEVEL = SYSOP.SECURITY.LEVEL
SYSOP = TRUE
RIGHT.MARGIN = 72
GOSUB 41500
IF LOCAL.USER THEN _
SNOOP = TRUE : _
SYSOP.NEXT = TRUE : _
GOSUB 33090
830 IF USER.SECURITY.LEVEL <> DEFAULT.SECURITY.LEVEL THEN _
Z$ = "" : _
Z = 0 : _
GOSUB 5140 : _
IF FOUND THEN _
MINUTES.PER.SESSION! = TEMP.TIME.ALLOWED
836 IF LOCAL.USER THEN _
IF PRINTER THEN _
LPRINT " Sysop on locally at ";CURRENT.DATE$;", ";TIM$
837 IF NOT LOCAL.USER THEN _
Z$ = ACTIVE.USER.NAME$ + _
" on at " + _
CURRENT.DATE$ + _
", " + _
TIM$ + _
" from " + _
CI$ + _
", " + _
BAUD.PARITY$ : _
NG$ = FN S$(Z$,128) : _
Z$ = " " + Z$ : _
GOSUB 13674 : _
IF NEW.USER THEN _
Z$ = "NEWUSER" : _
GOSUB 13665
NEW.USER = FALSE
842 SECONDS.PER.SESSION! = (MINUTES.PER.SESSION! + LIMIT.DAILY.TIME * ELAPSED.TIME) * 60
GOSUB 4910
CALLS.TODATE! = CALLS.TODATE! + 1 + SYSOP
GOSUB 24000
GET 1,NODE.RECORD.INDEX
MID$(MESSAGE.RECORD$,1,31) = FN S$(ACTIVE.USER.NAME$,31)
MID$(MESSAGE.RECORD$,57,1) = "A"
MID$(MESSAGE.RECORD$,60,4) = BAUD.PARITY$
PUT 1,NODE.RECORD.INDEX
GOSUB 21996
IF SYSOP THEN _
GOTO 900 _
ELSE SYSOP = (USER.SECURITY.LEVEL >= SYSOP.SECURITY.LEVEL)
850 GOSUB 950
IF ACTIVE.BULLETINS < 1 THEN _
A$ = "There are no bulletins today" : _
GOSUB 1397 : _
GOTO 900
855 IF BULLETINS.OPTIONAL THEN _
A$ = "Would you like to skip the" + STR$(ACTIVE.BULLETINS) + " bulletins" : _
GOSUB 1499 : _
IF YES THEN _
GOTO 900
860 GOSUB 9705
900 GOSUB 1900
GOSUB 950
GOTO 955
'
' *****************************************************************************
' * LINE 25 UPDATE ROUTINE *
' *****************************************************************************
'
950 IF NOT SNOOP THEN _
RETURN
953 CURSOR.LINE = CSRLIN
CURSOR.ROW = POS(0)
HH = LEN(ACTIVE.USER.NAME$) + LEN(CI$) + LEN(LINE.25$) + 18
LOCATE 25,1
IF NETWORK.TYPE = 0 THEN _
LOCK.STATUS$ = SPACE$(3)+TIME.LOGGED.ON$
954 PRINT LINE.25$;SPACE$(79-HH);STR$(USER.SECURITY.LEVEL);" ";ACTIVE.USER.NAME$;" ";CI$;" ";LOCK.STATUS$;
LOCATE CURSOR.LINE,CURSOR.ROW
RETURN
955 GOSUB 4850
STOP.INTERRUPTS = TRUE
'
' *****************************************************************************
' * *
' * MAIN MENU PROCESSING *
' * *
' *****************************************************************************
'
1200 CLOSE 1
ACTIVE.MENU$ = "M"
GOSUB 49000
STOP.INTERRUPTS = TRUE
Q = 0
GOSUB 1405
IF USER.SECURITY.LEVEL < SYSOP.MENU.SECURITY.LEVEL THEN _
A1$ = ">" : _
GOTO 1240
A1$ = ",1,..,7>"
IF NOT EXPERT.USER THEN _
FILE.NAME$ = MENU$(1) : _
GOSUB 43025
1240 GOSUB 41050
NON.STOP = FALSE
IF NOT EXPERT.USER THEN _
FILE.NAME$ = MENU$(2) : _
GOSUB 43025
1250 GOSUB 49000
A$ = GRN$ + " Main Functions <B,C,D,E,F,G,H,I,J,K,L,O,P,Q,R,S,U,V,W,X,?" + A1$
GOSUB 1499
IF Q = 0 THEN _
GOTO 1250
1270 FOR J = 1 TO Q
Z$ = B$(J)
Z$ = FN UC$(Z$)
FF = VAL(Z$)
IF FF = 0 THEN _
GOTO 1280
IF FF < 1 OR FF > 7 THEN _
GOSUB 1350 : _
GOTO 1200
1274 IF USER.SECURITY.LEVEL < SYSOP.FUNCTION(FF) THEN _
VIOLATION$ = "Sysop " + Z$ : _
GOSUB 1380 : _
GOTO 1200
1276 ON FF GOSUB 10070,10090,10390,10530,11000,33070,10930
GOTO 1200
1280 FF = INSTR("BCDEFGHIJKLOPQRSUVWX?",Z$)
IF FF = 0 THEN _
GOSUB 1350 : _
GOTO 1200
1290 IF USER.SECURITY.LEVEL < MAIN.FUNCTION(FF) THEN _
VIOLATION$ = "MMenu " + Z$ : _
GOSUB 1380 : _
GOTO 1200
1320 ON FF GOSUB 9700,1800,10970,2000,20015,10560,1740,1760,5300,3900,5200,4700,1900,4320,4330,4340,1330,5800,9800,4240,1700
NEXT
GOTO 1200
'
' *****************************************************************************
' * *
' * UTILITY MENU PROCESSING *
' * *
' *****************************************************************************
'
1330 ACTIVE.MENU$ = "U"
GOSUB 41050
IF NOT EXPERT.USER THEN _
FILE.NAME$ = MENU$(4) : _
GOSUB 43025
1334 GOSUB 49000
A$ = GRN$ + " Utility Functions <B,C,F,G,H,L,M,N,P,Q,R,S,T,U,X,!>"
GOSUB 1499
IF Q = 0 THEN _
GOSUB 1350 : _
GOTO 1330
1336 Z$ = B$(J)
Z$ = FN UC$(Z$)
FF = INSTR("BCFGHLMNPQRSTUX!",Z$)
IF FF = 0 THEN _
GOSUB 1360 : _
GOTO 1330
IF USER.SECURITY.LEVEL < UTILITY.FUNCTION(FF) THEN _
VIOLATION$ = "Util " + Z$ : _
GOSUB 1380 : _
GOTO 1330
1338 ON FF GOSUB 5500,42960,42800,43000,1780,4100,10925,42710,5110,1200,5400,4850,9100,10090,4240,4200
GOTO 1330
1350 IF EXPERT.USER THEN _
RETURN
GOSUB 1405
1360 A$ = B$(J) + " is invalid, " + FIRST.NAME$
GOSUB 1405
RETURN
'
' *****************************************************************************
' * RECORD SECURITY VIOLATIONS *
' *****************************************************************************
'
1380 A$ = "SYSOP must authorize"
GOSUB 1397
Z$ = "SV!-" + VIOLATION$
GOSUB 13670
VIOLATIONS.THIS.SESSION = VIOLATIONS.THIS.SESSION + 1
IF MAXIMUM.VIOLATIONS = 0 OR VIOLATIONS.THIS.SESSION <= MAXIMUM.VIOLATIONS THEN _
RETURN
1385 IF USER.FILE.INDEX < 1 THEN _
RETURN
A$ = "SECURITY VIOLATION! Sysop can reinstate"
IF USER.SECURITY.LEVEL <= MINIMUM.LOGON.SECURITY THEN _
A$ = "" : _
USER.SECURITY.LEVEL = USER.SECURITY.LEVEL-1 _
ELSE USER.SECURITY.LEVEL = MINIMUM.LOGON.SECURITY
1386 GOSUB 1405
LOGON.ERROR.INDEX = 5
GOSUB 21997
GET 2,USER.FILE.INDEX
LSET SECURITY.LEVEL$ = MKI$(USER.SECURITY.LEVEL)
PUT 2,USER.FILE.INDEX
GOTO 10620
1397 A$ = "Sorry, " + FIRST.NAME$ + ", " + A$
GOTO 1405
'
' *****************************************************************************
' * COMMON OUTPUT ROUTINE *
' *****************************************************************************
'
1398 GOSUB 1485
GOTO 1405
1399 GOSUB 1485
1400 CR = 1
1403 CR = CR + 1
1405 RET = FALSE
IF NOT STOP.INTERRUPTS OR CM OR INP(MODEM.STATUS.REGISTER) <128 THEN _
GOTO 1435
1410 GOSUB 60000
Y$ = KEY.PRESSED$
IF LOCAL.USER THEN _
GOTO 1430
1415 IF EOF(3) THEN _
GOSUB 42000 : _
GOTO 1430
1420 Y$ = INPUT$(1,3)
1425 IF Y$ = XOFF$ THEN _
WHILE EOF(3) : _
GOSUB 42000 : _
WEND : _
GOTO 1420
1430 IF Y$ = CHR$(11) AND STOP.INTERRUPTS THEN _
GOTO 1475
1432 IF Y$ = CANCEL$ AND STOP.INTERRUPTS THEN _
GOTO 1475
1435 IF NOT SNOOP THEN _
GOTO 1437
LOCATE ,,1
IF COLOR.SUPPORT AND A$ <> "" THEN _
CALL ANSI(A$,C.C,C.L) : _
LOCATE C.C,C.L : _
GOTO 1437
CURSOR.ROW = 1
WHILE CURSOR.ROW <= LEN(A$)
CURSOR.LINE = CURSOR.ROW + _
INSTR(MID$(A$,CURSOR.ROW) + _
CARRIAGE.RETURN$,CARRIAGE.RETURN$) - 2
PRINT MID$(A$,CURSOR.ROW,CURSOR.LINE-CURSOR.ROW + 1); _
MID$(LINE.FEED$,1,-(CURSOR.LINE < LEN(A$)));
CURSOR.ROW = CURSOR.LINE + LEN(RETURN.LINE.FEED$) + 2
WEND
1437 IF LOCAL.USER THEN _
GOTO 1450
1440 IF UPPER.CASE THEN _
A$ = FN UC$(A$)
1445 IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,A$;
1450 IF CR <> 1 THEN _
GOSUB 1485 _
ELSE IF CR > 1 THEN _
GOSUB 1485
1470 Y$ = ""
A$ = Y$
CR = 0
RETURN
1475 CR = 2
A$ = ""
RET = STOP.INTERRUPTS
STOP.INTERRUPTS = FALSE
GOSUB 1410
STOP.INTERRUPTS = RET
RET = TRUE
NON.STOP = FALSE
GOTO 1470
1485 IF SNOOP THEN _
PRINT
1490 IF NOT LOCAL.USER AND INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,RETURN.LINE.FEED$;
1495 RETURN
1496 RETURN.LINE.FEED$ = MID$(CARRIAGE.RETURN$,1,-(CI$ <> "LOCAL")) + _
NUL$ + _
MID$(LINE.FEED$,1,-LINE.FEEDS)
RETURN
1499 GOSUB 1485
'
' *****************************************************************************
' * COMMON INPUT ROUTINE *
' *****************************************************************************
'
1500 GOSUB 42000
TOA! = FRE("A")
AUTO.LOGOFF! = FN TI! + WAIT.BEFORE.DISCONNECT
A = 0
B = 0
C = 0
Q = 1
EOL = FALSE
YES = FALSE
B$ = ""
NO = FALSE
A$ = A$ + "? "
GOSUB 1403
IF LOCAL.USER THEN _
LINE INPUT "",B$ : _
GOTO 1575
IF PROMPT.BELL AND INP(MODEM.STATUS.REGISTER) >127 THEN _
PRINT #3,CHR$(7);
1525 WHILE EOF(3)
GOSUB 42000
IF FN TI! > AUTO.LOGOFF! THEN _
GOTO 10590
1530 GOSUB 60000
Y$ = KEY.PRESSED$
IF Y$ <> "" THEN _
GOTO 1545
1531 WEND
GOSUB 42000
1540 Y$ = INPUT$(1,3)
IF TEST.PARITY THEN _
GOTO 1541 _
ELSE IF Y$ = CHR$(127) THEN _
GOTO 1635 _
ELSE GOTO 1545
1541 IF ASC(Y$) = 141 THEN _
OUT LINE.CONTROL.REGISTER,&H1A : _
EIGHT.BIT = FALSE : _
TEST.PARITY = FALSE : _
GR = FALSE
1542 Y$ = CHR$(ASC(Y$) AND 127)
1545 IF Y$ = CHR$(8) OR _
Y$ = CHR$(7) OR _
Y$ = CHR$(26) OR _
Y$ = CHR$(227) THEN _
GOTO 1635
1550 IF Y$ < " " AND Y$ <> CARRIAGE.RETURN$ THEN _
GOTO 1525
1553 IF Y$ = "^" THEN _
GOTO 1525
1555 IF SNOOP THEN _
PRINT Y$;
1557 IF NOT HIDDEN AND INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,Y$; _
ELSE IF INP(MODEM.STATUS.REGISTER) > 127 THEN_
PRINT #3,".";
1560 IF Y$ = CARRIAGE.RETURN$ THEN _
GOTO 1570
1563 IF LEN(B$) >= 254 THEN _
A$ = "Input too long!" : _
GOSUB 1405 : _
GOTO 1500
1565 B$ = B$ + Y$
GOTO 1525
1570 IF LINE.FEEDS AND INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,LINE.FEED$;
1575 A = INSTR(B$,";")
IF A = 0 THEN _
GOTO 1620
1580 B$(1) = LEFT$(B$,A-1)
A = A + 1
1585 B = INSTR(A,B$,";")
C = B-A
IF C < 1 THEN _
EOL = TRUE : _
C = 128
1595 DF$ = MID$(B$,A,C)
IF DF$ <> "" THEN _
Q = Q + 1 : _
B$(Q) = DF$
1605 IF NOT EOL AND Q < 10 THEN _
A = B + 1 : _
GOTO 1585
1610 IF LEN(B$) > 64 THEN _
A$ = "Try again, " + FIRST.NAME$ : _
GOSUB 1405 : _
GOTO 1500
GOTO 1625
1620 B$(1) = B$
Q = 1
IF B$ = "" THEN _
Q = 0 : _
RETURN
1625 B$ = FN UC$(B$)
IF LEFT$(B$,1) = "Y" THEN _
YES = TRUE _
ELSE IF LEFT$(B$,1) = "N" THEN _
NO = TRUE
1628 IF B$(Q) = "NS" OR B$(Q) = "ns" THEN _
NO = FALSE : _
NON.STOP = TRUE : _
B$(Q) = "" : _
IF Q > 1 THEN _
Q = Q-1
1629 IF B$ = "RE" AND USER.SECURITY.LEVEL >= MAIN.FUNCTION(4) THEN _
REPLY = TRUE : _
RETURN
IF B$ = "K" AND USER.SECURITY.LEVEL >= MAIN.FUNCTION(10) THEN _
KILL.MESSAGE = TRUE
RETURN
1635 IF LEN(B$) = 0 THEN _
GOTO 1525
1640 B$ = LEFT$(B$,LEN(B$)-1)
IF SNOOP THEN _
PRINT BACK.ARROW$;
1650 IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,BACKSPACE$;
GOTO 1525
'
' *****************************************************************************
' * BAUD RATE CHANGE ROUTINE *
' *****************************************************************************
'
1654 LINE.CONTROL.STATUS = INP(LINE.CONTROL.REGISTER)
MSB.SAVE = INP(MSB)
OUT MSB,0
OUT LINE.CONTROL.REGISTER,LINE.CONTROL.STATUS OR 128
IF BAUD.RATE.DIVISOR = &H180 THEN _
OUT LSB,&H80 : _
OUT MSB,&H1 : _
GOTO 1684
1662 IF BAUD.RATE.DIVISOR = &H100 THEN _
OUT LSB,&H0 : _
OUT MSB,&H1 : _
GOTO 1684
1664 IF BAUD.RATE.DIVISOR = &H60 THEN _
OUT LSB,&H60 : _
OUT MSB,&H0 : _
GOTO 1684
1666 IF BAUD.RATE.DIVISOR = &H30 THEN _
OUT LSB,&H30 : _
OUT MSB,&H0
1684 OUT LINE.CONTROL.REGISTER,LINE.CONTROL.STATUS
OUT MSB,MSB.SAVE
RETURN
'
' *****************************************************************************
' * ? - COMMAND FROM MAIN MENU (FUNCTIONS SUPPORTED) *
' *****************************************************************************
'
1700 FILE.NAME$ = HELP$(2)
GOTO 1765
'
' *****************************************************************************
' * H - COMMAND FROM MAIN MENU (HELP) *
' *****************************************************************************
'
1740 FILE.NAME$ = HELP$(1)
GOTO 1765
'
' *****************************************************************************
' * I - COMMAND FROM MAIN MENU (DISPLAY INITIAL WELCOME) *
' *****************************************************************************
'
1760 FILE.NAME$ = WELCOME.FILE$
1765 GOSUB 1790
RETURN
'
' *****************************************************************************
' * H - COMMAND FROM UTILITIES MENU (HELP) *
' *****************************************************************************
'
1780 FILE.NAME$ = HELP$(8)
1790 GOSUB 43030
GOSUB 6000
RETURN
'
' *****************************************************************************
' * C - COMMAND FROM MAIN MENU (LEAVE COMMENT FOR SYSOP) *
' *****************************************************************************
'
1800 A$ = "Comments require no replies. " + _
"Do you wish to leave a comment for " + _
SYSOP.FIRST.NAME$ + _
" (Y/N)"
GOSUB 1499
RIGHT.MARGIN = 72
IF NOT YES THEN _
GOSUB 1405 : _
RETURN
1840 MESSAGE.TO$ = "SYSOP"
SUBJECT$ = "COMMENT"
SYSOP.COMMENT = TRUE
GOTO 2007
1850 CLOSE 2
BX = &H3
EN$ = COMMENTS.FILE$
GOSUB 29000
IF SHARE.IT THEN _
OPEN COMMENTS.FILE$ FOR APPEND SHARED AS #2 _
ELSE OPEN "A",2,COMMENTS.FILE$
A$ = FIRST.NAME$ + ", Thanks for comments!"
GOSUB 1399
GOSUB 41510
PRINT #2,ACTIVE.USER.NAME$,CURRENT.DATE$,TIM$
FOR X = 1 TO LINES.IN.MESSAGE
PRINT #2,A$(X)
NEXT
PRINT #2,CARRIAGE.RETURN$
CLOSE 2
BX = &H3
EN$ = COMMENTS.FILE$
GOSUB 29500
Z$ = "Left comment"
GOSUB 13665
RETURN
'
' *****************************************************************************
' * P - COMMAND FROM MAIN MENU (DISPLAY PERSONAL MAIL) *
' *****************************************************************************
'
1900 GOSUB 30500
A$ = "Checking messages"
GOSUB 1403
SHOW.ACTIVE = TRUE
MESSAGES.FROM.USER = FALSE
ACTIVE.MESSAGES = 0
GOSUB 23000
MESSAGE.RECORD = FIRST.MESSAGE.RECORD
ACTIVE.DELAY! = 0
MAXIMUM.MESSAGES = VAL(MID$(MESSAGE.RECORD$,89,7))
FOR DF = 1 TO MAXIMUM.MESSAGES
M(DF,1) = 0
M(DF,2) = 0
NEXT
1905 GET 1,MESSAGE.RECORD
NUMBER.RECORDS.IN.MESSAGE = VAL(MID$(MESSAGE.RECORD$,118))
IF NUMBER.RECORDS.IN.MESSAGE < 1 THEN _
NUMBER.RECORDS.IN.MESSAGE = 1
1906 IF SHOW.ACTIVE AND FN TI! > ACTIVE.DELAY! THEN _
A$ = "." : _
GOSUB 1403 : _
ACTIVE.DELAY! = FN TI! + 1
1910 IF MESSAGE.RECORD >= NEXT.MESSAGE.RECORD THEN _
LOW.MESSAGE.NUMBER = M(1,2) : _
GOTO 1950
1915 IF MID$(MESSAGE.RECORD$,116,1) = DELETED.MESSAGE$ OR _
MID$(MESSAGE.RECORD$,116,1) <> ACTIVE.MESSAGE$ THEN _
GOTO 1946
1920 IF INSTR(MID$(MESSAGE.RECORD$,37,31),ACTIVE.USER.NAME$) OR _
(SYSOP AND INSTR(MID$(MESSAGE.RECORD$,37,31),"SYSOP")) OR _
(SYSOP AND INSTR(MID$(MESSAGE.RECORD$,37,31),SYSOP.FIRST.NAME$ + " " + SYSOP.LAST.NAME$)) THEN _
GOTO 1925
GOTO 1935
1925 IF SHOW.ACTIVE THEN _
A$ = "Mail may be for YOU (* = Private)" : _
GOSUB 1399 : _
SHOW.ACTIVE = FALSE
1930 A$ = LEFT$(MESSAGE.RECORD$,5)
GOSUB 1403
1935 IF INSTR(MID$(MESSAGE.RECORD$,6,31),ACTIVE.USER.NAME$) OR _
(SYSOP AND INSTR(MID$(MESSAGE.RECORD$,6,31),"SYSOP")) OR _
(SYSOP AND INSTR(MID$(MESSAGE.RECORD$,6,31),SYSOP.FIRST.NAME$ + " " + SYSOP.LAST.NAME$)) THEN _
GOTO 1940
GOTO 1945
1940 IF MESSAGES.FROM.USER < 128 THEN _
MESSAGES.FROM.USER = MESSAGES.FROM.USER + 1 : _
B$(MESSAGES.FROM.USER) = LEFT$(MESSAGE.RECORD$,5)
1945 ACTIVE.MESSAGES = ACTIVE.MESSAGES + 1
M(ACTIVE.MESSAGES,1) = MESSAGE.RECORD
M(ACTIVE.MESSAGES,2) = VAL(MID$(MESSAGE.RECORD$,2,4))
1946 MESSAGE.RECORD = MESSAGE.RECORD + NUMBER.RECORDS.IN.MESSAGE
GOTO 1905
1950 IF MESSAGES.FROM.USER = 0 OR NOT MESSAGE.REMINDER THEN _
RETURN
A$ = "Mail you may have left"
GOSUB 1399
1960 FOR I = 1 TO MESSAGES.FROM.USER
A$ = B$(I)
GOSUB 1403
NEXT
A$ = "Please <K>ill your old or unneeded messages"
GOSUB 1398
RETURN
'
' *****************************************************************************
' * E - COMMAND FROM MAIN MENU (ENTER MESSAGE) *
' *****************************************************************************
'
2000 IF ACTIVE.MESSAGES = MAXIMUM.MESSAGES THEN _
A$ = "Too many active messages! Leave a comment for Sysop! Try tomorrow" : _
GOSUB 1398 : _
GOTO 3650
2006 MESSAGE.PASSWORD$ = ""
SYSOP.COMMENT = FALSE
IF NOT REPLY THEN _
MESSAGE.TO$ = ""
2007 IF SYSOP.COMMENT THEN _
Z$ = COMMENTS.FILE$ : _
FT$ = "comment" _
ELSE Z$ = ACTIVE.MESSAGE.FILE$ : _
FT$ = "message"
2008 IF SYSOP.COMMENT THEN _
GOSUB 52000 : _
GOTO 2009
FREE.SPACE$ = "2000"
IF NEXT.MESSAGE.RECORD + 5 >= HIGHEST.MESSAGE.RECORD THEN _
FREE.SPACE$ = "1"
2009 IF VAL(FREE.SPACE$) < 2000 THEN _
A$ = "No room for " + FT$ : _
GOSUB 1405 : _
GOTO 3650
2010 LINES.IN.MESSAGE = 0
L = 0
X = 0
FOR I = 1 TO 30
A$(I) = ""
NEXT
IF SYSOP.COMMENT THEN _
GOTO 2100
2020 IF REPLY THEN _
GOTO 2060
A$ = "To (Press [ENTER] for All)"
GOSUB 1499
IF LEN(B$(1)) > 30 THEN _
A$ = "30 Char. Max" : _
GOSUB 1405 : _
GOTO 2020
2030 IF Q = 0 THEN _
MESSAGE.TO$ = "ALL" _
ELSE MESSAGE.TO$ = FN UC$(B$(1))
2035 A$ = "Subject"
GOSUB 1500
IF LEN(B$(1)) > 25 THEN _
A$ = "25 Char. Max" : _
GOSUB 1405 : _
GOTO 2035
2045 IF Q = 0 THEN _
GOTO 20095
SUBJECT$ = FN UC$(B$(1))
2060 A$ = "Security: K)ill, P)assword, R)eceiver, N)one, H)elp "
GOSUB 1500
IF Q = 0 THEN _
GOTO 2060
Z$ = FN UC$ (LEFT$(B$(1),1))
ON INSTR("RKNPH",Z$) GOTO 2075,2090,2100,2088,2070
GOTO 2060
'
' *****************************************************************************
' * DISPLAY MESSAGE PROTECT HELP *
' *****************************************************************************
'
2070 FILE.NAME$ = HELP$(3)
GOSUB 1790
GOTO 2060
'
' *****************************************************************************
' * MAKE MESSAGE READ PROTECTED (ONLY ADDRESSEE AND SYSOP CAN READ IT) *
' *****************************************************************************
'
2075 IF MESSAGE.TO$ = "ALL" THEN _
A$ = "Message to ALL cannot be Receiver protected!" : _
GOSUB 1405 : _
GOTO 2060
2077 IF INSTR(MESSAGE.TO$,"SYSOP") OR _
INSTR(MESSAGE.TO$,SYSOP.FIRST.NAME$ + " " + SYSOP.LAST.NAME$) THEN _
GOTO 2081
2079 IF NOT REPLY THEN _
TEMP.USER.NAME$ = MESSAGE.TO$ : _
FOUND = FALSE : _
SUIX = USER.FILE.INDEX : _
GOSUB 12600 : _
USER.FILE.INDEX = SUIX : _
GOSUB 21995 : _
IF NOT FOUND THEN _
A$ = MESSAGE.TO$ + " is not an active user." : _
GOSUB 1397 : _
GOTO 2020
2081 A$ = "Sending personal mail to " + MESSAGE.TO$
GOSUB 1405
2084 MESSAGE.PASSWORD$ = "^READ^"
GOTO 2100
2085 A$ = "Password":'
GOSUB 1500
IF Q = 0 THEN _
GOTO 2085
IF LEN(B$(1)) > L THEN _
A$ = STR$(L) + " Chars. max" : _
GOSUB 1405 : _
GOTO 2085
IF L = 15 AND MID$(B$(1),1,1) = "!" THEN _
A$ = "Password can't begin with '!'" : _
GOSUB 1405 : _
GOTO 2085
RETURN
'
' *****************************************************************************
' * MAKE MESSAGE PASSWORD PROTECTED (USERS WITH PASSWORD AND SYSOP CAN READ) *
' *****************************************************************************
'
2088 A$ = "Receiver(s) Must KNOW PASSWORD TO READ msg. Use password (Y/N)"
GOSUB 1500
IF NO THEN _
GOTO 2070
L = 14
A1$ = "!"
GOTO 2092
'
' *****************************************************************************
' * MAKE MESSAGE KILL PROTECTED (ONLY SENDER, ADDRESSEE AND SYSOP CAN KILL) *
' *****************************************************************************
'
2090 L = 15
A1$ = ""
2092 GOSUB 2085
MESSAGE.PASSWORD$ = A1$ + FN UC$(B$(1))
'
' *****************************************************************************
' * ENTER MAIN BODY OF MESSAGE *
' *****************************************************************************
'
2100 A$ = "Type " + _
FT$ + _
" Press [ENTER] to end," + _
STR$(MAX.MESSAGE.LINES) + _
" lines max)"
GOSUB 1398
GOSUB 3200
2125 LINES.IN.MESSAGE = LINES.IN.MESSAGE + 1
A$ = RIGHT$(STR$(LINES.IN.MESSAGE),2) + ": " + A$(LINES.IN.MESSAGE)
GOSUB 1403
GOSUB 3700
IF A$(LINES.IN.MESSAGE) = "" THEN _
LINES.IN.MESSAGE = LINES.IN.MESSAGE-1 : _
GOTO 2300
2140 J = LINES.IN.MESSAGE
GOSUB 2200
IF X THEN _
GOTO 2300
GOTO 2125
2200 X = 0
IF J < (MAX.MESSAGE.LINES-2) THEN _
RETURN
A$ = MID$("2 lines leftLast line Full",12*(J-(MAX.MESSAGE.LINES-2)) + 1,12)
X = (J > (MAX.MESSAGE.LINES-1))
2210 GOSUB 1405
RETURN
'
' *****************************************************************************
' * FINAL MESSAGE DISPOSITION *
' *****************************************************************************
'
2300 GOSUB 1405
IF NOT EXPERT.USER THEN _
GOSUB 50400
2315 A$ = "Editor Sub-function <A,C,D,E,I,L,M,S,?>"
GOSUB 1499
IF Q = 0 THEN _
GOTO 2315
Z$ = FN UC$(B$(1))
2325 IF Q > 1 AND Z$ <> "M" THEN _
L = VAL(B$(Q)) : _
GOSUB 3320
2330 ON INSTR("ACDEILMS?",Z$) GOTO 2400,2340,2500,2600,2800,3000,3100,3400,2345
GOTO 2300
'
' *****************************************************************************
' * CONTINUE ENTERING MESSAGE *
' *****************************************************************************
'
2340 GOSUB 3200
GOTO 2140
'
' *****************************************************************************
' * DISPLAY MESSAGE SUBCOMMANDS HELP FILE *
' *****************************************************************************
'
2345 FILE.NAME$ = HELP$(4)
GOSUB 1790
GOTO 2315
'
' *****************************************************************************
' * ABORT MESSAGE *
' *****************************************************************************
'
2400 A$ = "Abort " + FT$ + " (Y/N)"
GOSUB 1499
IF NOT YES THEN _
GOTO 2300
2430 A$ = "Aborted"
GOSUB 1398
GOTO 3650
'
' *****************************************************************************
' * DELETE MESSAGE LINE *
' *****************************************************************************
'
2500 GOSUB 1405
IF Q = 1 THEN _
A$ = "Delete " : _
GOSUB 1403 : _
GOSUB 3300
2520 A$ = "Line #" + STR$(L)
GOSUB 1405
A$ = A$(L)
GOSUB 1400
A$ = "Delete this line (Y/N)"
GOSUB 1500
IF NOT YES THEN _
A$ = "NOT Deleted" : _
GOSUB 1405 : _
GOTO 2300
2550 LINES.IN.MESSAGE = LINES.IN.MESSAGE-1
FOR X = L TO LINES.IN.MESSAGE
A$(X) = A$(X + 1)
NEXT
A$(LINES.IN.MESSAGE + 1) = ""
A$ = "Deleted Line #" + STR$(L)
GOSUB 1405
GOTO 2300
'
' *****************************************************************************
' * EDIT MESSAGE LINE *
' *****************************************************************************
'
2600 GOSUB 1405
IF Q = 1 THEN _
GOSUB 3300
2620 A$ = "Line #" + STR$(L) + " is:" + RETURN.LINE.FEED$ + A$(L)
GOSUB 1400
A$ = "Enter <Oldstring;New> or Press [ENTER] to end"
GOSUB 1405
B$(2) = ""
GOSUB 1500
IF Q = 0 THEN _
GOTO 2300
2660 X = INSTR(1,A$(L),B$(1))
IF X = 0 THEN _
GOTO 2710
2670 FF = LEN(B$(1))
JJ = LEN(B$(2))
IF FF = JJ THEN _
MID$(A$(L),X) = B$(2) : _
GOTO 2620
2690 CC$ = MID$(A$(L),X + FF)
DF$ = LEFT$(A$(L),X-1)
A$(L) = DF$ + B$(2) + CC$
GOTO 2620
2710 A$ = "String <" + B$(1) + "> not found in line" + STR$(L)
GOSUB 1405
GOTO 2300
'
' *****************************************************************************
' * INSERT MESSAGE LINE *
' *****************************************************************************
'
2800 IF LINES.IN.MESSAGE >= MAX.MESSAGE.LINES AND NOT SYSOP THEN _
A$ = "Message full" : _
GOSUB 1405 : _
GOTO 2920
2820 GOSUB 1405
IF Q = 1 THEN _
A$ = "Before " : _
GOSUB 1403 : _
GOSUB 3300
2830 LL = LINES.IN.MESSAGE
K = LINES.IN.MESSAGE-L
FOR X = L TO LINES.IN.MESSAGE
B$(X + 1-L) = A$(X)
A$(X) = ""
NEXT
LINES.IN.MESSAGE = L
2840 A$ = RIGHT$(STR$(LINES.IN.MESSAGE),2) + ": "
GOSUB 1403
GOSUB 3700
IF A$(LINES.IN.MESSAGE) = "" THEN _
GOTO 2920
2870 LINES.IN.MESSAGE = LINES.IN.MESSAGE + 1
J = LINES.IN.MESSAGE + K-1
GOSUB 2200
IF X THEN _
GOTO 2920 _
ELSE GOTO 2840
2920 FOR X = 1 TO K + 1
A$(LINES.IN.MESSAGE + X-1) = B$(X)
NEXT
LINES.IN.MESSAGE = LL + LINES.IN.MESSAGE-L
GOTO 2300
'
' *****************************************************************************
' * LIST MESSAGE CONTENTS *
' *****************************************************************************
'
3000 STOP.INTERRUPTS = TRUE
GOSUB 1405
IF Q = 1 THEN _
L = 1 : _
A$ = "To: " + MESSAGE.TO$ + " Re: " + SUBJECT$ : _
GOSUB 1405 : _
GOSUB 3200
3020 FOR X = L TO LINES.IN.MESSAGE
IF RET THEN _
GOTO 2300 _
ELSE A$ = RIGHT$(STR$(X),2) + ": " + A$(X)
3030 GOSUB 1405
NEXT
GOTO 2300
'
' *****************************************************************************
' * CHANGE MARGIN WIDTH *
' *****************************************************************************
'
3100 GOSUB 1405
IF Q <> 1 THEN _
B$(1) = B$(Q) : _
GOTO 3130
3115 A$ = "SET Right-Margin from" + STR$(RIGHT.MARGIN) + " TO (8...72)"
GOSUB 1500
IF LEN(B$(1)) > 2 THEN _
GOTO 3140
3130 X = VAL(B$(1))
IF X > 7 AND X < 73 THEN _
RIGHT.MARGIN = X : _
A$ = "Margin now" + STR$(RIGHT.MARGIN) : _
GOTO 3150
3140 A$ = "Invalid - Margin UNCHANGED"
3150 GOSUB 1405
IF UTILITY.MARGIN.CHANGE THEN _
RETURN
GOTO 2300
3200 A$ = " [" + STRING$(RIGHT.MARGIN-2,45) + "]"
GOSUB 1398
RETURN
3300 A$ = "Line #"
GOSUB 1500
L = VAL(B$(1))
3320 IF L >= 1 AND L <= LINES.IN.MESSAGE THEN _
RETURN
3330 IF Q = 0 THEN _
RETURN 2300
3340 A$ = "No such line"
GOSUB 1405
RETURN 2300
'
' *****************************************************************************
' * SAVE MESSAGE *
' *****************************************************************************
'
3400 IF SYSOP.COMMENT THEN _
GOTO 1850
3405 GOSUB 4910
MESSAGE.RECORD.SAVE$ = MESSAGE.RECORD$
A$ = "Adding new msg #" + STR$(HIGH.MESSAGE.NUMBER + 1)
GOSUB 1403
REC = 0
N$ = ""
HIGH.MESSAGE.NUMBER = HIGH.MESSAGE.NUMBER + 1
ACTIVE.MESSAGES = ACTIVE.MESSAGES + 1
MESSAGE.NUMBER$ = STR$(HIGH.MESSAGE.NUMBER) + _
SPACE$(5-LEN(STR$(HIGH.MESSAGE.NUMBER)))
IF MESSAGE.PASSWORD$ = "^READ^" THEN _
MID$(MESSAGE.NUMBER$,1,1) = "*"
3460 MESSAGE.FROM$ = FN S$(ACTIVE.USER.NAME$,31)
MESSAGE.TO$ = FN S$(MESSAGE.TO$,31)
MID$(MESSAGE.TO$,23,8) = TIME$
SUBJECT$ = FN S$(SUBJECT$,25)
MESSAGE.PASSWORD$ = FN S$(MESSAGE.PASSWORD$,15)
FOR J = 1 TO LINES.IN.MESSAGE
A$(J) = A$(J) + CHR$(227)
REC = REC + LEN(A$(J))
NEXT
IF REC MOD 128 = 0 THEN _
N$ = STR$(REC\128 + 1) _
ELSE N$ = STR$(REC\128 + 2)
3530 GET 1,NEXT.MESSAGE.RECORD
M(ACTIVE.MESSAGES,1) = NEXT.MESSAGE.RECORD
M(ACTIVE.MESSAGES,2) = HIGH.MESSAGE.NUMBER
LSET MESSAGE.RECORD$ = MESSAGE.NUMBER$ + _
MESSAGE.FROM$ + _
MESSAGE.TO$ + _
CURRENT.DATE$ + _
SUBJECT$ + _
MESSAGE.PASSWORD$ + _
ACTIVE.MESSAGE$ + _
N$
PUT 1,NEXT.MESSAGE.RECORD
NEXT.MESSAGE.RECORD = NEXT.MESSAGE.RECORD + VAL(N$)
N$ = ""
FOR J = 1 TO LINES.IN.MESSAGE
A$ = "."
GOSUB 1403
N$ = N$ + A$(J)
IF LEN(N$) > 127 THEN _
LSET MESSAGE.RECORD$ = N$ : _
PUT 1 : _
N$ = MID$(N$,129)
3630 NEXT
IF LEN(N$) > 0 THEN _
LSET MESSAGE.RECORD$ = N$ : _
PUT 1
3640 GOSUB 1405
LSET MESSAGE.RECORD$ = MESSAGE.RECORD.SAVE$
GOSUB 24000
GOSUB 21996
3650 IF REPLY THEN _
GOSUB 30500 : _
RETURN
GOTO 20095
'
' *****************************************************************************
' * ENTER MESSAGE/COMMENT LINES *
' *****************************************************************************
'
3700 RS$ = A$(LINES.IN.MESSAGE)
COL = LEN(RS$)
STOP.INTERRUPTS = FALSE
3720 COL = COL + 1
3730 IF LOCAL.USER THEN _
X$ = INPUT$(1) : _
GOTO 3740
3732 AUTO.LOGOFF! = FN TI! + WAIT.BEFORE.DISCONNECT
WHILE EOF(3)
IF FN TI! > AUTO.LOGOFF! THEN _
GOTO 10590
3733 GOSUB 42000
GOSUB 60000
X$ = KEY.PRESSED$
IF LEN(X$) = 1 THEN _
GOTO 3740
3736 WEND
3737 X$ = INPUT$(1,3)
IF X$ = LINE.FEED$ OR _
X$ = CHR$(11) OR _
X$ = CHR$(12) THEN _
GOTO 3730
3738 IF X$ = CHR$(127) THEN _
GOTO 3870
3740 IF X$ = CHR$(8) OR _
X$ = CHR$(7) OR _
X$ = CHR$(26) OR _
X$ = CHR$(227) THEN _
GOTO 3870
3750 A$ = X$
GOSUB 1403
IF X$ = CARRIAGE.RETURN$ THEN _
GOTO 3850
3770 IF COL > RIGHT.MARGIN-3 AND X$ = " " THEN _
GOSUB 1405 : _
GOTO 3860
3780 RS$ = RS$ + X$
IF COL < RIGHT.MARGIN + 1 THEN _
GOTO 3720
3800 Z = LEN(RS$)
FOR I = 1 TO LEN(RS$)
IF MID$(RS$,Z,1) = " " THEN _
GOTO 3820
3810 Z = Z-1
NEXT
Z = LEN(RS$)-1
3820 COL = RIGHT.MARGIN + 1 - Z
IF SNOOP THEN _
LOCATE ,POS(0)-COL: _
PRINT STRING$(COL,32);
3830 IF NOT LOCAL.USER AND INP(MODEM.STATUS.REGISER) > 127 THEN _
PRINT #3,STRING$(COL,8); STRING$(COL,32);
3840 A$(LINES.IN.MESSAGE) = LEFT$(RS$,Z)
A$(LINES.IN.MESSAGE + 1) = RIGHT$(RS$,COL)
GOSUB 1405
RETURN
3850 IF NOT LOCAL.USER AND LINE.FEEDS AND INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,LINE.FEED$;
3860 A$(LINES.IN.MESSAGE) = RS$
RETURN
3870 IF COL = 1 THEN _
GOTO 3730
COL = COL-2
RS$ = LEFT$(RS$,LEN(RS$)-1)
3880 IF SNOOP THEN _
PRINT BACK.ARROW$;
3885 IF NOT LOCAL.USER AND INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,BACKSPACE$;
3890 GOTO 3720
'
' *****************************************************************************
' * K - COMMAND FROM MAIN MENU (KILL MESSAGE) *
' *****************************************************************************
'
3900 KILL.MESSAGE = FALSE
GOSUB 1405
IF Q <> 1 THEN _
MESSAGE.TO.KILL = VAL(B$(Q)) : _
GOTO 3950
3930 A$ = "Msg # to Kill"
GOSUB 1500
MESSAGE.TO.KILL = VAL(B$(Q))
GOSUB 1405
3950 FOR QX = 1 TO ACTIVE.MESSAGES
IF M(QX,2) = MESSAGE.TO.KILL AND MESSAGE.TO.KILL >= 1 THEN _
GOTO 3970
3955 NEXT
GOSUB 3965
GOTO 4040
3965 A$ = "No such msg #" + STR$(MESSAGE.TO.KILL)
GOSUB 1405
RETURN
3970 GOSUB 21990
GET 1,M(QX,1)
R = VAL(MID$(MESSAGE.RECORD$,118))
IF SYSOP THEN _
GOTO 4030
3980 Z$ = FN SS$(MID$(MESSAGE.RECORD$,101,15))
IF LEN(Z$) = 0 THEN _
GOTO 4030
3990 IF Z$ = "^READ^" THEN _
IF INSTR(MESSAGE.RECORD$,ACTIVE.USER.NAME$) THEN _
GOTO 4030 _
ELSE MESSAGE.PASSWORD = TRUE : _
ATTEMPTS.ALLOWED = 0 : _
GOSUB 680 : _
GOSUB 25000 : _
GOTO 4040
4000 IF LEFT$(Z$,1) = "!" THEN _
Z$ = MID$(Z$,2)
4010 PASSWORD.SAVE$ = FN S$(Z$,15)
ATTEMPTS.ALLOWED = 1
MESSAGE.PASSWORD = TRUE
GOSUB 667
IF PASSWORD.FAILED THEN _
GOSUB 25000 : _
GOTO 4040
4030 LSET MESSAGE.RECORD$ = LEFT$(MESSAGE.RECORD$,115) + _
DELETED.MESSAGE$ + _
MID$(MESSAGE.RECORD$,117)
PUT 1,LOC(1)
A$ = "Killed Msg # " + STR$(MESSAGE.TO.KILL)
GOSUB 1405
GOSUB 25000
4040 IF KILL.MESSAGE THEN _
RETURN
GOTO 20095
'
' *****************************************************************************
' * L - COMMAND FROM UTILITY MENU (LINE FEEDS TOGGLE) *
' *****************************************************************************
'
4100 LINE.FEEDS = NOT LINE.FEEDS
A$ = "Line Feeds " + MID$("OffOn",1-3*LINE.FEEDS,3)
GOSUB 1496
GOSUB 1405
RETURN
'
' *****************************************************************************
' * P - COMMAND FROM UTILITY MENU (PROMPT BELL TOGGLE) *
' *****************************************************************************
'
4200 PROMPT.BELL = NOT PROMPT.BELL
A$ = "Prompting Bell " + MID$("OffOn",1-3*PROMPT.BELL,3)
GOSUB 1405
RETURN
'
' *****************************************************************************
' * X - COMMAND FROM MAIN MENU (EXPERT TOGGLE) *
' * X - COMMAND FROM UTILITY MENU (EXPERT TOGGLE) *
' * X - COMMAND FROM FILES MENU (EXPERT TOGGLE) *
' *****************************************************************************
'
4240 EXPERT.USER = NOT EXPERT.USER
A$ = MID$("NoviceExpert",1-6*EXPERT.USER,6)
GOSUB 1405
RETURN
'
' *****************************************************************************
' * Q - COMMAND FROM MAIN MENU (QUICK SCAN MESSAGES) *
' *****************************************************************************
'
4320 QUICK.SCAN.MESSAGES = TRUE
READ.MESSAGES = FALSE
SCAN.MESSAGES = FALSE
GOTO 4350
'
' *****************************************************************************
' * R - COMMAND FROM MAIN MENU (READ MESSAGES) *
' *****************************************************************************
'
4330 QUICK.SCAN.MESSAGES = FALSE
READ.MESSAGES = TRUE
SCAN.MESSAGES = FALSE
GOTO 4350
'
' *****************************************************************************
' * S - COMMAND FROM MAIN MENU (SCAN MESSAGE HEADERS) *
' *****************************************************************************
'
4340 QUICK.SCAN.MESSAGES = FALSE
READ.MESSAGES = FALSE
SCAN.MESSAGES = TRUE
'
' *****************************************************************************
' * MESSAGE READ MAINLINE (QUICK SCAN, READ & SCAN ALL USE THIS ROUTINE *
' *****************************************************************************
'
4350 GOSUB 30500
QAH = -READ.MESSAGES-QUICK.SCAN.MESSAGES-SCAN.MESSAGES*5
IF Q > 2 AND VAL(B$(Q)) = 0 THEN _
Z$ = FN UC$(B$(Q)) : _
Q = Q-1 _
ELSE Z$ = ""
4360 LG$(11) = Z$
MESSAGES.SELECTED.INDEX = 1
NUMBER.MESSAGES.SELECTED = Q
ADDRESSED.TO.USER = FALSE
4370 MESSAGES.SELECTED.INDEX = MESSAGES.SELECTED.INDEX + 1
4371 IF MESSAGES.SELECTED.INDEX <= NUMBER.MESSAGES.SELECTED THEN _
CURRENT.MESSAGE = VAL(B$(MESSAGES.SELECTED.INDEX)) : _
GOTO 4415
4380 NON.STOP = FALSE
ADDRESSED.TO.USER = FALSE
A$ = "Msg # (" + _
STR$(LOW.MESSAGE.NUMBER) + _
" to" + _
STR$(M(ACTIVE.MESSAGES,2)) + _
", *, <H>elp)"
IF EXPERT.USER THEN _
GOTO 4400
4390 IF READ.MESSAGES THEN _
A$ = A$ + " to Retrieve (Press [ENTER] to end)" _
ELSE A$ = "Starting at " + A$
4400 GOSUB 1500
IF Q = 0 THEN _
GOTO 20095
IF INSTR("Hh",LEFT$(B$(1),1)) THEN _
FILE.NAME$ = HELP$(7) : _
GOSUB 1790 : _
RETURN
MESSAGES.SELECTED.INDEX = 0
NUMBER.MESSAGES.SELECTED = Q
GOTO 4370
4415 FORWARD = FALSE
REVERSE = FALSE
IF B$(MESSAGES.SELECTED.INDEX) = "*" THEN _
CURRENT.MESSAGE = LAST.MESSAGE.READ + 1 : _
FORWARD = TRUE : _
GOTO 4430
4416 IF INSTR("Mm",B$(MESSAGES.SELECTED.INDEX)) THEN _
ADDRESSED.TO.USER = TRUE : _
GOTO 4370
IF CURRENT.MESSAGE = 0 THEN _
GOTO 20095
GOSUB 1405
4430 IF RIGHT$(B$(MESSAGES.SELECTED.INDEX),1) = "+" THEN _ ' CPC131A3
FORWARD = TRUE
IF RIGHT$(B$(MESSAGES.SELECTED.INDEX),1) = "-" THEN _
REVERSE = TRUE : _
GOTO 4490
4450 FOR MESSAGE.DIM.INDEX = 1 TO ACTIVE.MESSAGES
IF READ.MESSAGES AND _
M(MESSAGE.DIM.INDEX,2) = CURRENT.MESSAGE THEN _
GOTO 4520
4470 IF ((READ.MESSAGES AND FORWARD) OR QUICK.SCAN.MESSAGES OR SCAN.MESSAGES) AND _
M(MESSAGE.DIM.INDEX,2) >= CURRENT.MESSAGE THEN _
GOTO 4520
4480 NEXT
GOTO 4515
4490 FOR MESSAGE.DIM.INDEX = ACTIVE.MESSAGES TO 1 STEP -1
IF M(MESSAGE.DIM.INDEX,2) <= CURRENT.MESSAGE THEN _
GOTO 4540
4510 NEXT
4515 MESSAGE.TO.KILL = CURRENT.MESSAGE
GOSUB 3965
GOTO 4370
4520 ENDING.MESSAGE.INDEX = MESSAGE.DIM.INDEX
IF READ.MESSAGES AND NOT FORWARD THEN _
GOTO 4560
4530 STARTING.MESSAGE.INDEX = MESSAGE.DIM.INDEX
ENDING.MESSAGE.INDEX = ACTIVE.MESSAGES
SO = 1
GOTO 4550
4540 STARTING.MESSAGE.INDEX = MESSAGE.DIM.INDEX
ENDING.MESSAGE.INDEX = 1
SO = -1
4550 FOR MESSAGE.DIM.INDEX = STARTING.MESSAGE.INDEX TO _
ENDING.MESSAGE.INDEX STEP SO
4560 GET 1,M(MESSAGE.DIM.INDEX,1)
PASSWORD.FAILED = 0
UH = 0
Z$ = MID$(MESSAGE.RECORD$,101,15)
X = 1
4561 FF = INSTR(MID$(MESSAGE.RECORD$,X),ACTIVE.USER.NAME$)
IF FF THEN _
X = LEN(ACTIVE.USER.NAME$) + FF : _
IF (FF < 7 OR MID$(MESSAGE.RECORD$,FF-1,1) = " ") AND (X > 66 OR MID$(MESSAGE.RECORD$,X,1) = " ") THEN _
UH = TRUE _
ELSE IF FF < 37 THEN _
X = 37 : _
GOTO 4561
4562 IF NOT SYSOP THEN _
IF INSTR(MESSAGE.RECORD$,"^READ^") > 0 AND NOT UH THEN _
PASSWORD.FAILED = TRUE : _
IF FORWARD OR REVERSE THEN _
GOTO 4635
4563 CURRENT.MESSAGE = VAL(MID$(MESSAGE.RECORD$,2,4))
IF ADDRESSED.TO.USER AND NOT UH THEN _
GOTO 4625
4580 IF INSTR(MESSAGE.RECORD$,LG$(11)) = 0 THEN _
GOTO 4635
4581 IF MID$(MESSAGE.RECORD$,116,1) = DELETED.MESSAGE$ THEN _
GOTO 4630
4582 PG = FALSE
IF MID$(Z$,1,1) = "!" THEN _
IF NOT SYSOP THEN _
PG = TRUE : _
PASSWORD.SAVE$ = MID$(Z$,2) + " " : _
ATTEMPTS.ALLOWED = 0 : _
GOSUB 665
4584 IF PASSWORD.FAILED AND _
(QUICK.SCAN.MESSAGES OR (SCAN.MESSAGES AND NOT PG)) THEN _
GOTO 4635
4585 IF PASSWORD.FAILED THEN _
IF PG THEN _
SJ$ = "<PASSWORD>" _
ELSE SJ$ = "<PROTECTED>" _
ELSE SJ$ = MID$(MESSAGE.RECORD$,76,25)
4590 IF QUICK.SCAN.MESSAGES THEN _
A$ = FN SS$(LEFT$(MESSAGE.RECORD$,5) + " " + SJ$ + " ") : _
GOSUB 1405 : _
GOTO 4630
4600 GOSUB 8000
IF SCAN.MESSAGES OR RET THEN _
GOTO 4630
IF M(MESSAGE.DIM.INDEX,2) > LAST.MESSAGE.READ THEN _
LAST.MESSAGE.READ = M(MESSAGE.DIM.INDEX,2)
4610 IF NOT PASSWORD.FAILED THEN _
GOTO 4613
IF PG THEN _
ATTEMPTS.ALLOWED = 2 : _
GOSUB 667
4611 IF PASSWORD.FAILED THEN _
GOTO 4625
4613 GOSUB 9000
GOSUB 1405
IF Q = 0 OR PAGE.LENGTH = 0 THEN _
GOTO 4625
4614 GOSUB 41000
KILL.MESSAGE = FALSE
REPLY = FALSE
IF NON.STOP THEN _
GOTO 4625
4616 A$ = "More (Y),N,NS,RE" + MID$(",K",1,-UH*2)
GOSUB 1500
IF NO THEN _
GOTO 4650
'
' *****************************************************************************
' * KILL CURRENT MESSAGE *
' *****************************************************************************
'
4618 IF KILL.MESSAGE AND (UH OR SYSOP) THEN _
IF USER.SECURITY.LEVEL >= MAIN.FUNCTION(10) THEN _
GOSUB 62520 : _
MESSAGE.TO.KILL = CURRENT.MESSAGE : _
GOSUB 3950 : _
GOSUB 62530 : _
GOTO 4625 _
ELSE VIOLATION$ = "MMenu R) Func 10" : _
GOSUB 1380 : _
GOTO 4625
'
' *****************************************************************************
' * REPLY TO CURRENT MESSAGE *
' *****************************************************************************
'
4620 IF NOT REPLY THEN _
GOTO 4625
4621 IF USER.SECURITY.LEVEL < MAIN.FUNCTION(4) THEN _
VIOLATION$ = "MMenu R) Func 4" : _
GOSUB 1380 : _
REPLY = FALSE : _
GOTO 4625
IF LEFT$(SUBJECT$,3) <> "(R)" THEN _
SUBJECT$ = "(R)" + LEFT$(SUBJECT$,22)
4622 MESSAGE.TO$ = MESSAGE.FROM$
MESSAGE.FROM$ = ACTIVE.USER.NAME$
GOSUB 62520
GOSUB 2000
REPLY = FALSE
GOSUB 62530
GOTO 4560
4625 IF NOT FORWARD AND NOT REVERSE THEN _
GOTO 4370
4630 IF PAGE.LENGTH = 0 THEN _
GOTO 4631
Q = Q + QAH
IF Q < PAGE.LENGTH THEN _
GOTO 4631
GOSUB 5600
IF NO THEN _
Q = 0 : _
GOTO 4650
Q = QAH
4631 GOSUB 42000
IF RET THEN _
GOTO 20095
4635 NEXT
IF READ.MESSAGES THEN _
GOTO 4370
4650 GOSUB 1405
A$ = "End of Msgs"
GOSUB 1405
GOTO 20095
'
' *****************************************************************************
' * O - COMMAND FROM MAIN MENU (OPERATOR PAGE) *
' *****************************************************************************
'
4700 IF NOT SYSOP.AVAILABLE GOTO 4708
4705 A$ = "Chat. Remote Conversation"
GOSUB 1399
JJ = FN V(TIME$ ,1)*100 + FN V(TIME$ ,4)
IF (JJ > START.OFFICE.HOURS AND JJ < END.OFFICE.HOURS) OR SYSOP.ANNOY THEN _
GOTO 4710
4707 GOTO 4750
4708 A$ = "SYSOP is in from" + _
STR$(START.OFFICE.HOURS) + _
" to" + _
STR$(END.OFFICE.HOURS) + ","
GOSUB 1405
GOTO 4755
4710 A$ = "Page " + SYSOP.FIRST.NAME$ + " (Y/N)"
GOSUB 1499
IF NO THEN _
RETURN
PAGE.COUNT = 0
A$ = "Paging " + SYSOP.FIRST.NAME$ + " now"
GOSUB 1403
PAGE.TIME.MAX! = FN TI! + 30
4730 GOSUB 50500
4735 PAGE.COUNT = PAGE.COUNT + 1
IF INKEY$ = ESCAPE$ THEN _
GOTO 4765
4740 IF PAGE.COUNT MOD 2 THEN _
A$ = PAGING.PRINTER.SUPPORT$ + CHR$(7) : _
IF LEN(PAGING.PRINTER.SUPPORT$) = 3 THEN _
IF PRINTER THEN _
LPRINT CHR$(7);
4745 GOSUB 1403
IF FN TI! < PAGE.TIME.MAX! THEN _
GOTO 4730
GOSUB 1405
4750 A$ = SYSOP.FIRST.NAME$ + " is in from" + _
STR$(START.OFFICE.HOURS) + _
" to" + _
STR$(END.OFFICE.HOURS) + _
", but not now"
GOSUB 1397
4755 A$ = "If you would like, Please leave a message or a comment"
GOSUB 1405
Z$ = "Operator paged " + LEFT$(TIME$ ,5)
GOSUB 13670
RETURN
4765 Z$ = "Paged and chatted with Sysop"
GOSUB 13665
A$ = "SYSOP available! Hi this is " + _
SYSOP.FIRST.NAME$ + _
" go ahead!"
GOSUB 1399
4770 CM = TRUE
TIME.CHAT.STARTED! = FN TI!
GOSUB 49000
4775 WHILE EOF(3)
LOCATE ,,1
GOSUB 60000
A$ = KEY.PRESSED$
IF A$ = CHR$(8) OR _
A$ = CHR$(7) OR _
A$ = CHR$(26) OR _
A$ = CHR$(127) OR _
A$ = CHR$(227) THEN _
GOTO 4805
4777 IF A$ = ESCAPE$ THEN _
A$ = "" : _
CM = 0 : _
SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + _
FIX(FN TI! - TIME.CHAT.STARTED!) : _
A$ = "Chat mode terminated. Returning to normal board operations." : _
GOSUB 1399 : _
GOTO 4820
4785 IF A$ = CARRIAGE.RETURN$ THEN _
GOTO 4811
4790 IF A$ <> "" THEN _
GOTO 4800
4795 WEND
4797 A$ = INPUT$(1,3)
IF A$ = CHR$(8) OR _
A$ = CHR$(127) THEN _
GOTO 4805 _
ELSE IF A$ = CARRIAGE.RETURN$ THEN _
GOTO 4811
4800 WORD.WRAP$ = WORD.WRAP$ + A$
IF LEN(WORD.WRAP$) = 78 THEN _
GOTO 4813 _
ELSE GOSUB 1403 : _
GOTO 4775
4805 IF POS(0) > 1 THEN _
PRINT BACK.ARROW$; : _
PRINT #3,BACKSPACE$; : _
QQ = LEN(WORD.WRAP$)-1 : _
WORD.WRAP$ = LEFT$(WORD.WRAP$,QQ)
4810 GOTO 4775
4811 IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,CARRIAGE.RETURN$;
PRINT CARRIAGE.RETURN$;
WORD.WRAP$ = ""
Q = 0
IF LINE.FEEDS AND INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,LINE.FEED$
GOTO 4775
4813 IF A$ = " " THEN _
WORD.WRAP$ = "" : _
Q = 0 : _
GOSUB 1400 : _
GOTO 4775
Z = LEN(WORD.WRAP$)
Q = 0
4814 IF MID$(WORD.WRAP$,Z,1) = " " THEN _
WORD.WRAP$ = MID$(WORD.WRAP$,Z + 1) _
ELSE Z = Z - 1 : _
Q = Q + 1 : _
IF Q >= 70 THEN _
GOTO 4811 _
ELSE GOTO 4814
4815 IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,STRING$(Q,8);STRING$(Q,32);CARRIAGE.RETURN$;
IF LINE.FEEDS AND INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,LINE.FEED$
4816 LOCATE ,POS(0)-Q
PRINT STRING$(Q,32);CARRIAGE.RETURN$;
A$ = WORD.WRAP$
Q = 0
GOSUB 1403
GOTO 4775
4820 IF ACTIVE.MENU$ = "U" THEN _
RETURN 1330
IF ACTIVE.MENU$ = "F" THEN _
RETURN 20015
RETURN 1200
'
' *****************************************************************************
' * S - COMMAND FROM UTILITY MENU (STATISTICS) *
' *****************************************************************************
'
4850 A$ = "RBBS-PC Version " + VERSION.ID$ + " Node " + NODE.ID$
GOSUB 1398
IF NOT CONFERENCE.MODE THEN _
A$ = "Caller # " + STR$(CALLS.TODATE!) + " "
4855 A$ = A$ + "# active msgs:" + STR$(ACTIVE.MESSAGES)
A$ = A$ + " Next msg #" + STR$(HIGH.MESSAGE.NUMBER + 1)
LAST.MESSAGE.READ = -LAST.MESSAGE.READ * _
(LAST.MESSAGE.READ <= HIGH.MESSAGE.NUMBER)
IF LAST.MESSAGE.READ > 0 THEN _
A$ = A$ + " Last msg read:" + STR$(LAST.MESSAGE.READ)
4857 GOSUB 1399
IF SYSOP THEN _
USER.WORK = (HIGHEST.USER.RECORD * .95) + 1: _
A$ = "USERS: used" + _
STR$(CURRENT.USER.COUNT-1) + _
" avl" + _
STR$(USER.WORK - CURRENT.USER.COUNT) + _
" MSGS: used" + _
STR$(ACTIVE.MESSAGES) + _
" avl" + _
STR$(MAXIMUM.MESSAGES-ACTIVE.MESSAGES) + _
" MSG REC: used" + _
STR$(NEXT.MESSAGE.RECORD-1) + _
" avl" + _
STR$(HIGHEST.MESSAGE.RECORD + 1 + NODES.IN.SYSTEM - NEXT.MESSAGE.RECORD) : _
GOSUB 1399
4860 GOSUB 1405
RETURN
4900 CONFERENCE.MODE = TRUE
Z$ = "Entered " + GRN$
GOSUB 13665
GRN$ = GRN$ + RETURN.LINE.FEED$
A$ = "Welcome to " + GRN$
GOSUB 1405
4905 NAME FILE.NAME$ AS FILE.NAME$
4906 GOSUB 43030
GOSUB 6000
4910 GOSUB 21990
IF LOF(1) = 0 THEN _
DF$ = ACTIVE.MESSAGE.FILE$ : _
CLOSE 1 : _
KILL ACTIVE.MESSAGE.FILE$ : _
GOSUB 25000 : _
GOTO 13600
GOSUB 23000
RETURN
'
' *****************************************************************************
' * REMOVE NON ALPHA CHARACTERS FROM STRING *
' *****************************************************************************
'
5100 X$ = ""
FOR Z = 1 TO LEN(Z$)
IF ASC(MID$(Z$,Z,1)) < 65 OR ASC(MID$(Z$,Z,1)) > 90 THEN _
GOTO 5105
X$ = X$ + MID$(Z$,Z,1)
5105 NEXT
Z$ = X$
RETURN
'
' *****************************************************************************
' * P - COMMAND FROM UTILITY MENU (PASSWORD CHANGE) *
' *****************************************************************************
'
5110 A$ = "Enter new password"
GOSUB 45010
IF Q = 0 THEN _
RETURN
IF LEN(B$(1)) > 15 OR B$(1) = SPACE$(LEN(B$(1))) THEN _
GOTO 5110
Z$ = FN UC$(B$(1))
5120 A$ = "Reenter new password"
GOSUB 45010
IF Q = 0 THEN _
RETURN
IF Z$ <> FN UC$(B$(1)) THEN _
A$ = "Passwords don't match!" : _
GOSUB 1405 : _
RETURN
5125 IF MAXIMUM.PASSWORD.CHANGES AND _
CHANGES.THIS.SESSION > _
MAXIMUM.PASSWORD.CHANGES AND _
NOT SYSOP THEN _
A$ = "No changes permitted" : _
GOSUB 1398 : _
RETURN _
ELSE PASSWORD.CHANGE.ALLOWED = TRUE : _
GOSUB 5140 : _
IF NOT FOUND THEN _
GOTO 5129 _
ELSE A$ = "Temporary change" : _
GOSUB 1398 : _
PASSWORD$ = TEMP.PASSWORD$ : _
SECONDS.PER.SESSION! = TEMP.TIME.ALLOWED * 60 : _
USER.SECURITY.LEVEL = TEMP.SECURITY.LEVEL : _
GOSUB 41070 : _
SYSOP = (USER.SECURITY.LEVEL >= SYSOP.SECURITY.LEVEL)
IF ACTIVE.USER.NAME$ = "SYSOP" THEN _
B$(1) = "********"
5126 Z$ = "Used temporary password " + B$(1)
GOSUB 13670
GOSUB 1405
RETURN
5129 GOSUB 21997
5130 GET 2,USER.FILE.INDEX
LSET PASSWORD$ = FN UC$(B$(1))
PUT 2,USER.FILE.INDEX
CLOSE 2
GOSUB 27500
A$ = "Password changed"
STOP.INTERRUPTS = FALSE
GOSUB 1398
IF MAXIMUM.PASSWORD.CHANGES THEN _
CHANGES.THIS.SESSION = CHANGES.THIS.SESSION + 1
5131 Z$ = "New Password " + FN UC$(B$(1))
GOTO 13670
'
' *****************************************************************************
' * SEARCH "PASSWORDS" FILE FOR TEMPORARY PASSWORDS *
' *****************************************************************************
'
5140 FOUND = FALSE
SWAP PASSWORDS.FILE$,FILE.NAME$
GOSUB 58000
SWAP PASSWORDS.FILE$,FILE.NAME$
IF BADNEWS = 53 THEN _
Z$ = "Missing file " + PASSWORDS.FILE$ : _
GOSUB 13670 : _
IF Z = 1 THEN _
Z$ = FN UC$(B$(1)) : _
GOTO 5160 _
ELSE GOTO 5160
Z$ = FN S$(Z$,15)
5150 IF EOF(2) THEN _
GOTO 5160
5151 INPUT #2,TEMP.PASSWORD$,TEMP.SECURITY.LEVEL,TEMP.TIME.ALLOWED
IF LEN(TEMP.PASSWORD$) > 15 THEN _
GOTO 5150
TEMP.PASSWORD$ = FN S$(TEMP.PASSWORD$,15)
IF Z$ <> TEMP.PASSWORD$ THEN _
GOTO 5150
IF PASSWORD.CHANGE.ALLOWED AND _
USER.SECURITY.LEVEL >= MINIMUM.SECURITY.FOR.TEMP.PASSWORD THEN _
FOUND = TRUE _
ELSE IF USER.SECURITY.LEVEL = TEMP.SECURITY.LEVEL THEN _
FOUND = TRUE _
ELSE 5150
5160 RETURN
'
' *****************************************************************************
' * L - COMMAND FROM MAIN MENU (LINES PER PAGE) *
' *****************************************************************************
'
5200 IF Q > 1 THEN _
GOTO 5230
5220 A$ = "CHANGE page length from" + STR$(PAGE.LENGTH) + " TO (0 = continuous)"
GOSUB 1500
IF Q = 0 THEN _
GOTO 1200
5230 A = VAL(B$(Q))
IF A < 0 OR A > 255 THEN _
GOTO 5220
PAGE.LENGTH = A
GOTO 1200
'
' *****************************************************************************
' * J - COMMAND FROM MAIN MENU (JOIN CONFERENCE) *
' *****************************************************************************
'
5300 NAME CONFERENCE.MENU$ AS CONFERENCE.MENU$
5310 IF Q > 1 THEN _
B$(1) = B$(2) : _
Q = 0 : _
IF LEN(B$(2)) > 1 THEN _
GOTO 5322 _
ELSE GOTO 5317
5312 IF EXPERT.USER THEN _
GOTO 5315
5313 FILE.NAME$ = CONFERENCE.MENU$
GOSUB 43025
5315 A$ = "Conference Function <J>oin, <L>ist, <M>ain, <Q>uit, <X>pert"
GOSUB 1500
IF Q = 0 THEN _
GOSUB 1405 : _
RETURN _
ELSE Z$ = B$(1)
5317 IF FN UC$(B$(1)) = "X" THEN _
GOSUB 4240 : _
GOTO 5312
FF = INSTR("JLMQ",FN UC$(B$(1)))
IF FF = 0 THEN _
GOTO 5312
ON FF GOTO 5320,5313,5350,2210
5320 IF Q > 1 THEN _
B$(1) = B$(2) : _
GOTO 5322
A$ = "Enter conference name"
GOSUB 1500
IF Q = 0 THEN _
GOTO 5312
5322 IF SYSOP OR LOCAL.USER THEN _
GOSUB 5700
5323 GRN$ = FN UC$(B$(1))
ACTIVE.MESSAGE.FILE$ = MID$(MAIN.MESSAGE.FILE$,1,2) + GRN$ + "M.DEF"
FILE.NAME$ = MID$(WELCOME.FILE$,1,2) + GRN$ + "W.DEF"
5324 NAME ACTIVE.MESSAGE.FILE$ AS ACTIVE.MESSAGE.FILE$
5325 IF ACTIVE.USER.NAME$ <> "SYSOP" THEN _
IF NOT (CONFERENCE.MODE AND (ACTIVE.USER.FILE$ = MAIN.USER.FILE$)) THEN _
GOSUB 26000 : _
GOSUB 9400 : _
GET 2,MAIN.USER.FILE.INDEX : _
GOSUB 9600 : _
PUT 2,MAIN.USER.FILE.INDEX : _
GOSUB 27000
5327 ACTIVE.USER.FILE$ = MID$(ACTIVE.USER.FILE$,1,2) + GRN$ + "U.DEF"
UPDATE.DATE = TRUE
5328 NAME ACTIVE.USER.FILE$ AS ACTIVE.USER.FILE$
5330 IF ACTIVE.USER.NAME$ = "SYSOP" THEN _
GOTO 5345
TEMP.USER.NAME$ = ACTIVE.USER.NAME$
GOSUB 12600
GOSUB 21995
5340 IF FOUND THEN _
USER.FILE.INDEX = LOC(2) : _
TIX = USER.FILE.INDEX : _
GOSUB 9500 : _
GOTO 5345
A$ = "You are not a member of the " + GRN$ + " conference!"
GOSUB 1397
GRN$ = ""
USER.FILE.INDEX = MAIN.USER.FILE.INDEX
ACTIVE.USER.FILE$ = MAIN.USER.FILE$
ACTIVE.MESSAGE.FILE$ = MAIN.MESSAGE.FILE$
GOSUB 30500
GOSUB 23000
CONFERENCE.MODE = FALSE
GOSUB 1405
RETURN
5345 GRN$ = GRN$ + " Conference"
IF UPDATE.DATE AND ACTIVE.USER.NAME$ <> "SYSOP" THEN _
LSET LAST.DATE.TIME.ON$ = CURRENT.DATE$ + _
" " + _
TIME.LOGGED.ON$ : _
PUT 2,USER.FILE.INDEX : _
GOSUB 27500
5347 GOSUB 4900
GOSUB 25000
RETURN 900
5350 GRN$ = ""
IF ACTIVE.USER.NAME$ = "SYSOP" THEN _
GOSUB 5700 : _
ACTIVE.MESSAGE.FILE$ = MAIN.MESSAGE.FILE$ : _
ACTIVE.USER.FILE$ = MAIN.USER.FILE$ : _
CONFERENCE.MODE = FALSE : _
GOSUB 1405 : _
GOSUB 1900 : _
RETURN 1200
Z$ = "Exited Conference "
GOSUB 13665
5360 IF CONFERENCE.MODE AND (ACTIVE.USER.FILE$ <> MAIN.USER.FILE$) THEN _
GOSUB 26000 : _
GOSUB 9400 : _
GET 2,TIX : _
GOSUB 9600 : _
PUT 2,TIX : _
GOSUB 27000
5362 IF CONFERENCE.MODE THEN _
ACTIVE.MESSAGE.FILE$ = MAIN.MESSAGE.FILE$ : _
ACTIVE.USER.FILE$ = MAIN.USER.FILE$ : _
CONFERENCE.MODE = FALSE : _
GOSUB 9400 : _
USER.FILE.INDEX = MAIN.USER.FILE.INDEX : _
GET 2,USER.FILE.INDEX : _
GOSUB 9500 : _
GOSUB 1900
GOSUB 1405
RETURN
'
' *****************************************************************************
' * R - COMMAND FROM UTILITY MENU (REVIEW PROFILE) *
' *****************************************************************************
'
5400 A$ = "Your PROFILE (utilities reset)"
GOSUB 1399
EXPERT.USER = NOT EXPERT.USER
GOSUB 4240
GOSUB 43020
FF = INSTR("AMXC",USER.TRANSFER.DEFAULT$)
FF = FF-5*(FF < 1)
GOSUB 42810
UPPER.CASE = NOT UPPER.CASE
GOSUB 42960
LINE.FEEDS = NOT LINE.FEEDS
GOSUB 4100
GOSUB 42720
PROMPT.BELL = NOT PROMPT.BELL
GOTO 4200
'
' *****************************************************************************
' * B - COMMAND FROM UTILITY MENU (300 TO 450 BAUD CHANGE) *
' *****************************************************************************
'
5500 IF BPS <> -1 THEN _
A$ = "only 300 baud can change speed" : _
GOSUB 1397 : _
RETURN
5507 A$ = "Change to 450 baud"
GOSUB 1500
IF NOT YES THEN _
RETURN
5510 A$ = "Change. Then press [ENTER] until I respond"
GOSUB 1405
FOR I = 1 TO 3
GOSUB 50510
NEXT
C = 0
BAUD.RATE.DIVISOR = &H100
GOSUB 1654
5530 C = C + 1
GOSUB 42000
IF C = 20 THEN _
Z$ = "Baud change failed" : _
GOSUB 13665 : _
GOTO 10595
GOSUB 50500
5535 IF EOF(3) THEN _
GOTO 5530
5536 IF ASC(INPUT$(1,3)) = 13 THEN _
GOTO 5540
5537 GOTO 5530
5540 Z$ = "Changed to 450 baud"
GOSUB 13670
A$ = Z$
GOSUB 1405
BPS = -2
RETURN
'
' *****************************************************************************
' * PROVIDE (Y),N,NS MESSAGES FOR TEXT FILES LONGER THAN PAGE LENGTH *
' *****************************************************************************
'
5600 GOSUB 41000
AUTO.LOGOFF! = FN TI! + WAIT.BEFORE.DISCONNECT
IF NON.STOP THEN _
RETURN _
ELSE A$ = "More (Y),N,NS" : _
GOSUB 1500 : _
RETURN
'
' *****************************************************************************
' * SAVE SYSOP LAST MESSAGE READ POINTER *
' *****************************************************************************
'
5700 GOSUB 21990
GET 1,1
MID$(MESSAGE.RECORD$,123,4)=MID$(STR$(LAST.MESSAGE.READ),2)
PUT 1,1
GOSUB 21996
RETURN
'
' *****************************************************************************
' * V - COMMAND FROM MAIN MENU (VIEW CONFERENCES) *
' *****************************************************************************
'
5800 A$ = "The V)iew Conferences command has not been implemented!"
GOSUB 1399
RETURN
'
' *****************************************************************************
' * DISPLAY TEXT FILES & SCAN DIRECTORIES *
' *****************************************************************************
'
6000 IF STOP.INTERRUPTS THEN _
A$ = "* <Ctrl K> or <Ctrl X> aborts <Ctrl S> suspends *" : _
GOSUB 1399
6020 CK = 0
GOTO 7100
6030 Q = -1
CK = 0
GOTO 7110
6080 A$ = "Missing file " + FILE.NAME$ + ". Please tell SYSOP"
GOSUB 1405
RETURN
'
' *****************************************************************************
' * SCAN DIRECTORIES (PRINT TEXT) *
' *****************************************************************************
'
7000 A$ = "Scanning Directory " + _
MID$(FILE.NAME$,3,INSTR(FILE.NAME$,".")-3) + _
" for " + _
A1$
GOSUB 1405
PG = TRUE
7100 GOSUB 58000
IF BADNEWS = 53 THEN _
Z$ = "Missing File " + FILE.NAME$ : _
GOSUB 13670 : _
GOTO 6080
Q = 0
FF = PAGE.LENGTH-1
7110 IF EOF(2) OR (INP(MODEM.STATUS.REGISTER) < 128 AND NOT LOCAL.USER) THEN _
GOTO 7260
7120 IF PAGE.LENGTH AND Q >= 0 THEN _
IF Q >= FF THEN _
GOSUB 5600 : _
IF NO THEN _
GOTO 7260 _
ELSE Q = 0
7130 LINE INPUT #2,A$
IF CK = 0 THEN _
GOTO 7250
7157 IF CK > 1 THEN _
Z$ = FN UC$(A$) : _
XXX = (INSTR(Z$,RS$) = 0) : _
GOTO 7190
7160 A = INSTR(9,MID$(A$,1,32),"/")
IF A = 0 THEN _
A = INSTR(9,MID$(A$,1,32),"-")
7162 IF A < 3 THEN _
GOTO 7110
IF INSTR("0123456789",MID$(A$,A-1,1)) = 0 THEN _
GOTO 7110
A = A-2
KEE$ = FN DC$(MID$(A$,A,8))
IF MID$(KEE$,3,1) = " " THEN _
MID$(KEE$,3,1) = "0"
7185 IF MID$(KEE$,5,1) = " " THEN _
MID$(KEE$,5,1) = "0"
7189 XXX = (KEE$ < RS$)
7190 IF XXX THEN _
GOTO 7110
IF PG THEN _
PG = FALSE : _
GOSUB 58000 : _
Q = 0 : _
GOTO 7110
7200 IF PG THEN _
GOTO 7110
7250 GOSUB 1405
Q = Q-(Q >= 0)
IF NOT RET THEN _
GOTO 7110
7260 A$ = ""
Q = 0
CLOSE 2
GOSUB 42000
RETURN
'
' *****************************************************************************
' * FORMAT MESSAGE HEADER INFORMATION FOR DISPLAY *
' *****************************************************************************
'
8000 GOSUB 1405
IF RET THEN _
RETURN
8020 IF MID$(MESSAGE.RECORD$,37,5) = "ALL " THEN _
MESSAGE.TO$ = "ALL" : _
GOTO 8040
8030 MESSAGE.TO$ = FN SS$(MID$(MESSAGE.RECORD$,37,22))
8040 SUBJECT$ = FN SS$(MID$(MESSAGE.RECORD$,76,25))
IF PASSWORD.FAILED THEN _
SUBJECT$ = SJ$
8050 MESSAGE.FROM$ = FN SS$(MID$(MESSAGE.RECORD$,6,31))
A$ = "Msg # " + _
LEFT$(MESSAGE.RECORD$,5) + _
" Dated " + _
MID$(MESSAGE.RECORD$,68,8) + _
" " + _
MID$(MESSAGE.RECORD$,59,8)
IF NOT RET THEN _
A$ = A$ + _
RETURN.LINE.FEED$ + _
" From: " + _
MESSAGE.FROM$ + _
RETURN.LINE.FEED$ + _
" To: " + _
MESSAGE.TO$ + _
RETURN.LINE.FEED$ + _
" Re: " + _
SUBJECT$
8080 GOSUB 1405
RETURN
'
' *****************************************************************************
' * UNCOMPRESS MESSAGE PRIOR TO DISPLAY *
' *****************************************************************************
'
9000 GOSUB 1405
Q = 4
FOR X = 2 TO VAL(MID$(MESSAGE.RECORD$,118))
GOSUB 1403
EOL = FALSE
J = 1
GET 1
9050 B = INSTR(J,MESSAGE.RECORD$,CHR$(227))
IF RET THEN _
RETURN
9060 C = B-J
IF C < 0 THEN _
C = 128 : _
EOL = TRUE
9070 A$ = MID$(MESSAGE.RECORD$,J,C)
IF EOL THEN _
GOTO 9090
9085 J = B + 1
GOSUB 57100
GOTO 9050
9090 NEXT
A$ = ""
RETURN
'
' *****************************************************************************
' * T - COMMAND FROM UTILITY MENU (TIME ON SYSTEM) *
' *****************************************************************************
'
9100 GOSUB 1405
GOSUB 9140
GOSUB 41510
A$ = "Now " + TIM$ + " Time on: "
IF HHH > 0 THEN _
A$ = A$ + STR$(HHH) + " Hrs"
9110 A$ = A$ + STR$(MMM) + " Min &" + STR$(SSS) + " Sec"
GOSUB 1405
RETURN
9140 H = FN V(TIME.LOGGED.ON$,1)
M = FN V(TIME.LOGGED.ON$,4)
S = FN V(TIME.LOGGED.ON$,7)
HH = FN V(TIME$ ,1)
MM = FN V(TIME$ ,4)
JJ = FN V(TIME$ ,7)
IF S <= JJ THEN _
SSS = JJ-S _
ELSE SSS = 60-(S-JJ) : _
M = M + 1
9150 IF M <= MM THEN _
MMM = MM-M _
ELSE MMM = 60-(M-MM) : _
H = H + 1
9160 IF H <= HH THEN _
HHH = HH-H : _
RETURN _
ELSE HHH = 24-(H-HH) : _
RETURN
'
' *****************************************************************************
' * OPEN AND DEFINE USER FILE RECORD VARIABLES *
' *****************************************************************************
'
9400 CLOSE 2
IF SHARE.IT THEN _
OPEN ACTIVE.USER.FILE$ FOR RANDOM SHARED AS #2 LEN=128 _
ELSE OPEN "R",2,ACTIVE.USER.FILE$,128
FIELD 2,31 AS USER.NAME$, _
15 AS PASSWORD$, _
2 AS SECURITY.LEVEL$, _
14 AS USER.OPTIONS$, _
24 AS CITY.STATE$, _
19 AS MACHINE.TYPE$, _
14 AS LAST.DATE.TIME.ON$, _
3 AS LIST.NEW.DATE$, _
2 AS USER.DOWNLOADS$, _
2 AS USER.UPLOADS$, _
2 AS ELAPSED.TIME$
FIELD 2,128 AS USER.RECORD$
RETURN
'
' *****************************************************************************
' * GET USER DEFAULTS *
' *****************************************************************************
'
9500 USER.SECURITY.LEVEL = CVI(SECURITY.LEVEL$)
LAST.MESSAGE.READ = CVI(MID$(USER.OPTIONS$,3,2))
USER.TRANSFER.DEFAULT$ = MID$(USER.OPTIONS$,5,1)
GR = VAL(MID$(USER.OPTIONS$,6,1))
USER.GRAPHIC.DEFAULT$ = MID$(" GC",GR + 1,-(GR > 0))
RIGHT.MARGIN = CVI(MID$(USER.OPTIONS$,7,2))
9510 USER.OPTIONS = CVI(MID$(USER.OPTIONS$,9,2))
PROMPT.BELL = FN BT(USER.OPTIONS,1)
EXPERT.USER = FN BT(USER.OPTIONS,2)
NULLS = FN BT(USER.OPTIONS,4)
UPPER.CASE = FN BT(USER.OPTIONS,8)
LINE.FEEDS = FN BT(USER.OPTIONS,16)
PAGE.LENGTH = ASC(MID$(USER.OPTIONS$,13))
9520 NUL$ = MID$(STRING$(5,0),1,-5*NULLS)
GOSUB 1496
RETURN
'
' *****************************************************************************
' * UPDATE USER DEFAULTS *
' *****************************************************************************
'
9600 LSET USER.OPTIONS$ = MKI$(TIMES.LOGGED.ON) + _
MKI$(LAST.MESSAGE.READ) + _
USER.TRANSFER.DEFAULT$ + _
MID$(STR$(GR),2,1) + _
MKI$(RIGHT.MARGIN) + _
MKI$(-PROMPT.BELL-2*EXPERT.USER-4*NULLS-8*UPPER.CASE-16*LINE.FEEDS) + _
MKI$(0) + _
CHR$(PAGE.LENGTH) + _
STRING$(1,0)
RETURN
'
' *****************************************************************************
' * B - COMMAND FROM MAIN MENU (READ BULLETINS) *
' *****************************************************************************
'
9700 IF ACTIVE.BULLETINS < 1 THEN _
A$ = "no bulletins today" : _
GOSUB 1397 : _
RETURN
9705 FILE.NAME$ = BULLETIN.MENU$
GOSUB 1790
9707 GOSUB 41000
NON.STOP = FALSE
A$ = "Bulletin # 1 thru" + STR$(ACTIVE.BULLETINS) + ", L)ist, Press [ENTER] to Quit"
GOSUB 1499
IF Q = 0 THEN _
GOSUB 1405 : _
RETURN
9708 IF FN UC$(B$(1)) = "L" THEN _
GOTO 9705
9711 Z$ = FN UC$(B$(1))
IF VAL(Z$) > 0 AND VAL(Z$) <= ACTIVE.BULLETINS THEN _
GOTO 9720
GOTO 9705
9720 B$(1) = FN RS$(B$(1))
Z$ = "Read Bulletin # " + B$(1)
GOSUB 13665
FILE.NAME$ = BULLETIN.PREFIX$ + FN UC$(B$(1))
STOP.INTERRUPTS = TRUE
GOSUB 1790
STOP.INTERRUPTS = FALSE
GOSUB 41050
GOTO 9707
'
' *****************************************************************************
' * W - COMMAND FROM MAIN MENU (WHO'S ON THE OTHER NODES) *
' *****************************************************************************
'
9800 IF CONFERENCE.MODE THEN _
A$ = "Nodes won't display within a conference!" : _
GOSUB 1400 : _
RETURN
GOSUB 1405
GOSUB 30500
FOR NODE.INDEX = 2 TO NODES.IN.SYSTEM + 1
GET 1,NODE.INDEX
A$ = MID$(MESSAGE.RECORD$,1,31) + _
"Node" + _
STR$(NODE.INDEX - 1) + _
LEFT$(" in",1-2*(MID$(MESSAGE.RECORD$,57,1) <> "A")) + _
"active " + _
MID$(MESSAGE.RECORD$,60,4) + _
" Baud"
GOSUB 1405
NEXT
RETURN
'
' *****************************************************************************
' * 1 - COMMAND FROM SYSOP MENU (DISPLAY COMMENTS) *
' *****************************************************************************
'
10070 FILE.NAME$ = COMMENTS.FILE$
GOSUB 6000
RETURN
'
' *****************************************************************************
' * U - COMMAND FROM UTILITY MENU (DISPLAY USERS) *
' * 2 - COMMAND FROM SYSOP MENU (DISPLAY USERS) *
' *****************************************************************************
'
10090 A$ = "List - <U>sers, <R>ecent callers, Press [ENTER] to quit"
GOSUB 1499
IF Q = 0 THEN _
RETURN
ON INSTR("UR",FN UC$(B$(1))) + 1 GOTO 10090,10096,10100
10096 GOSUB 12700
GOSUB 9400
STOP.INTERRUPTS = TRUE
Q = 0
FOR I = 1 TO HIGHEST.USER.RECORD-1
GET 2,I
IF ASC(USER.NAME$) = 0 OR LEFT$(USER.NAME$,3) = " " THEN _
GOTO 10099
A$ = LEFT$(USER.NAME$,20) + _
CITY.STATE$ + _
MACHINE.TYPE$ + _
LAST.DATE.TIME.ON$
GOSUB 1405
IF RET THEN _
RETURN
GOSUB 57110
10099 NEXT
STOP.INTERRUPTS = FALSE
RETURN
10100 GOTO 57000
'
' *****************************************************************************
' * 3 - COMMAND FROM SYSOP MENU (RECOVER MESSAGE) *
' *****************************************************************************
'
10390 A$ = "Recover Msg #"
GOSUB 1500
MESSAGE.TO.RECOVER = VAL(B$(1))
IF MESSAGE.TO.RECOVER < 1 THEN _
GOTO 1450
10410 MESSAGE.RECORD = FIRST.MESSAGE.RECORD
GOSUB 1405
GOSUB 30500
10420 GET 1,MESSAGE.RECORD
NUMBER.RECORDS.IN.MESSAGE = VAL(MID$(MESSAGE.RECORD$,118))
IF MESSAGE.RECORD >= NEXT.MESSAGE.RECORD THEN _
A$ = "No Msg #" + STR$(MESSAGE.TO.RECOVER) : _
GOSUB 1405 : _
RETURN
10440 IF VAL(MID$(MESSAGE.RECORD$,2,4)) <> MESSAGE.TO.RECOVER THEN _
MESSAGE.RECORD = MESSAGE.RECORD + NUMBER.RECORDS.IN.MESSAGE : _
GOTO 10420
10450 IF INSTR(MESSAGE.RECORD$,DELETED.MESSAGE$) <> 0 THEN _
GOSUB 22000 : _
LSET MESSAGE.RECORD$ = LEFT$(MESSAGE.RECORD$,115) + _
ACTIVE.MESSAGE$ + _
MID$(MESSAGE.RECORD$,117) : _
PUT 1,LOC(1) : _
GOSUB 25000 : _
A$ = "Restored Msg #" + STR$(MESSAGE.TO.RECOVER) : _
GOSUB 1405 : _
GOTO 10490
10480 A$ = "Msg #" + STR$(MESSAGE.TO.RECOVER) + " not Dead"
GOSUB 1405
RETURN
10490 A$ = "Re-Loading Msg File"
GOSUB 1405
GOSUB 1900
RETURN
'
' *****************************************************************************
' * 4 - COMMAND FROM SYSOP MENU (DELETE COMMENTS) *
' *****************************************************************************
'
10530 A$ = "Delete comments (Y/N)"
GOSUB 1500
IF YES THEN _
CLOSE 2 : _
IF SHARE.IT THEN _
OPEN COMMENTS.FILE$ FOR OUTPUT SHARED AS #2 _
ELSE OPEN "O",2,COMMENTS.FILE$
CLOSE 2
10550 GOTO 20095
10553 Z$ = "time limit exceeded!"
GOSUB 13665
IF LIMIT.DAILY.TIME THEN _
A$ = "Daily time limit exceeded! Please try tomorrow" _
ELSE A$ = "Session time limit exceeded."
GOSUB 1397
10555 IF KG THEN _
RETURN
'
' *****************************************************************************
' * G - COMMAND FROM MAIN MENU (GOODBYE) *
' * G - COMMAND FROM FILES MENU (GOODBYE) *
' *****************************************************************************
'
10560 GOSUB 9100
A$ = FIRST.NAME$ + ", Thanks for calling and please call again!"
GOSUB 1405
Z$ = "Logged off"
GOSUB 13665
GOTO 10595
10590 Z$ = "Sleep Disconnect "
GOSUB 13665
10595 GOSUB 9140
GOSUB 13700
IF SYSOP OR LOCAL.USER THEN _
GOSUB 5700
IF USER.FILE.INDEX < 1 THEN _
CLS : _
GOTO 13540
IF CONFERENCE.MODE AND (ACTIVE.USER.FILE$ <> MAIN.USER.FILE$) THEN _
GOSUB 21997 : _
GET 2,TIX : _
GOSUB 9600 : _
PUT 2,TIX : _
GOSUB 27500
10598 IF CONFERENCE.MODE THEN _
ACTIVE.MESSAGE.FILE$ = MAIN.MESSAGE.FILE$ : _
ACTIVE.USER.FILE$ = MAIN.USER.FILE$ : _
USER.FILE.INDEX = MAIN.USER.FILE.INDEX : _
GOSUB 9400 : _
GET 2,USER.FILE.INDEX : _
GOSUB 9500
10600 SYSOP = FALSE
GOSUB 21997
10601 GET 2,USER.FILE.INDEX
GOSUB 9600
IF LIST.DIRECTORY THEN _
LSET LIST.NEW.DATE$ = FN CD$(CURRENT.DATE$)
10605 LSET USER.DOWNLOADS$ = MKI$(DOWNLOADS)
LSET USER.UPLOADS$ = MKI$(UPLOADS)
GOSUB 41010
LSET ELAPSED.TIME$ = MKI$(ELAPSED.TIME + _
(SECONDS.PER.SESSION! / 60) - _
TIME.REMAINING!)
PUT 2,USER.FILE.INDEX
GOTO 13540
10620 Z$ = LG$(LOGON.ERROR.INDEX)
GOSUB 13670
Z$ = ACTIVE.USER.NAME$ + _
" on at " + _
CURRENT.DATE$ + _
", " + _
TIM$ + _
"** LOGON DENIED **, " + _
BAUD.PARITY$
NG$ = FN S$(Z$,128)
GOSUB 13674
10698 A$ = "Access denied!"
GOSUB 1399
GOTO 13540
'
' *****************************************************************************
' * SCAN FILE DIRECTORIES FOR DIRECTORY FILENAMES *
' *****************************************************************************
'
10720 CLS
10721 FILES B$(J)
X = CSRLIN
LOCATE 2,1,1
MAIN.DIRECTORY$ = FN S$(DIRECTORY.EXTENTION$,8)
FOR I = 2 TO X
FOR B = 1 TO 66 STEP 18
G = G + 1
B$(G) = ""
FOR QQ = 0 TO 7
H = SCREEN (I,(B + QQ))
B$(G) = B$(G) + CHR$(H)
NEXT
10733 IF LIST.NEW THEN _
IF (OMIT.MAIN.DIRECTORY$ = "YES" AND B$(G) = MAIN.DIRECTORY$) OR _
(OMIT.UPLOAD.DIRECTORY$ = "YES" AND B$(G) = UPLOAD.DIR.CHECK$) THEN _
G = G-1 : _
GOTO 10840
10740 IF LEFT$(B$(G),1) = " " THEN _
G = G-1 : _
RETURN
10840 NEXT
NEXT
RETURN
'
' *****************************************************************************
' * M - COMMAND FROM UTILITY MENU (CHANGE MARGINS) *
' *****************************************************************************
'
10925 UTILITY.MARGIN.CHANGE = TRUE
GOSUB 3100
UTILITY.MARGIN.CHANGE = FALSE
RETURN
'
' *****************************************************************************
' * 7 - COMMAND FROM SYSOP MENU (EXIT TO DOS) *
' *****************************************************************************
'
10930 IF DOS.VERSION < 2 OR REQUIRED.RINGS = 0 THEN _
A$ = "Remote exit to DOS not available." : _
GOTO 1200
10932 IF LOCAL.USER THEN _
A$ = "Only for remote SYSOP's" : _
GOTO 1200
10934 CLOSE 2
OPEN "O",2,RCTTY.BAT$
PRINT #2,"ECHO OFF"
PRINT #2,"CTTY ";COM.PORT$
PRINT #2,"ECHO RBBS-PC ";VERSION.ID$
PRINT #2,"ECHO SYSOP in Remote Console Mode at "; TIME$ ;" on "; DATE$
PRINT #2,DISK.FOR.DOS$;"COMMAND "
PRINT #2,"CTTY CON"
PRINT #2,RBBS.BAT$
10950 GOSUB 41500
Z$ = "Exited to DOS at " + TIM$
GOSUB 13670
GOTO 10992
'
' *****************************************************************************
' * D - COMMAND FROM MAIN MENU (EXIT TO DOORS) *
' *****************************************************************************
'
10970 IF NOT DOORS.AVAILABLE OR REQUIRED.RINGS = 0 THEN _
A$ = "All doors are locked!" : _
GOSUB 1405 : _
GOTO 20095
10973 FILE.NAME$ = MENU$(5)
GOSUB 43025
IF USER.SECURITY.LEVEL < DOORS.SECURITY.LEVEL THEN _
A$ = "You do not have a key for my doors!" : _
GOSUB 1405 : _
RETURN
10974 A$ = "Open which door (Press [ENTER] to quit)"
GOSUB 1500
IF Q = 0 THEN _
RETURN
Z$ = FN UC$(B$(1))
10976 GOSUB 58000
10978 IF EOF(2) THEN _
A$ = "No such door " + Z$ : _
GOSUB 1405 : _
GOTO 1200
GOSUB 42000
10982 LINE INPUT #2,A$
IF LEN(A$) < LEN(Z$) THEN _
GOTO 10978
IF INSTR(A$,Z$) = 0 THEN _
GOTO 10978
Z$ = Z$ + ".BAT"
10986 NAME Z$ AS Z$
10987 CLOSE 2
OPEN "O",2,RCTTY.BAT$
PRINT #2,Z$
PRINT #2,RBBS.BAT$
CLOSE 2
A$ = Z$ + " door opened at " + TIME$ + " on " + DATE$
GOSUB 1405
EXIT.TO.DOORS = TRUE
Z$ = LEFT$(Z$,LEN(Z$)-4) + " door opened!"
GOSUB 13670
10992 CLOSE 3
OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) OR 1
IF EXIT.TO.DOORS THEN _
IF MULTI.LINK.PRESENT THEN _
DEF SEG = MULTI.LINK.PRESENT : _
GOSUB 60500 : _
POKE (&H64 + PEEK(&H58) + 256*PEEK(&H59) + &HC),ASC(RIGHT$(COM.PORT$,1))-48 : _
AX = &H700 + DOORS.TERMINAL.TYPE : _
GOSUB 60510 : _
AX = &HB01 : _
BX = 0 : _
GOSUB 60510
10996 GOSUB 9140
GOSUB 43050
RUN "EXITRBBS.EXE"
'
' *****************************************************************************
' * 5 - COMMAND FROM SYSOP MENU (USER FILE MAINTENANCE) *
' *****************************************************************************
'
11000 TU = USER.FILE.INDEX
STOP.INTERRUPTS = TRUE
I = 1
SCAN.USERS = FALSE
A$ = "A)dd, L)st, P)rt, M)od, S)can users (Press [ENTER] to quit)"
GOSUB 1500
11003 IF Q = 0 THEN _
GOTO 20093
QQ = 0
Z$ = FN UC$(LEFT$(B$(1),1))
IF Z$ = "A" THEN _
GOTO 12300 _
ELSE IF Z$ = "M" THEN _
STOP.INTERRUPTS = FALSE _
ELSE IF Z$ = "P" THEN _
QQ = TRUE _
ELSE IF Z$ = "S" THEN _
SCAN.USERS = TRUE : _
STOP.INTERRUPTS = FALSE _
ELSE IF Z$ <> "L" THEN _
GOTO 11000
11005 GOSUB 9400
Z = 1
IF SCAN.USERS THEN _
A$ = "Scan for N)ame, P)wd, C)ity/St, S)ystem or L)evel" : _
GOSUB 1500 : _
SCAN.FUNCTION$ = FN UC$(LEFT$(B$(1),1)) : _
CR = 0 : _
GOSUB 1405 : _
GOSUB 12966 : _
GOTO 12962
11010 FOR J = Z TO HIGHEST.USER.RECORD-1
GET 2,J
11015 IF ASC(USER.NAME$) = 0 OR LEFT$(USER.NAME$,3) = " " THEN _
GOTO 11300
OF = CVI(SECURITY.LEVEL$)
A$ = RIGHT$(" "+STR$(LOC(2)),4) + _
":" + _
USER.NAME$ + _
"SECURITY" + _
RIGHT$(" "+STR$(OF),5) + _
" "
11020 A$ = A$ + _
"Password = " + _
PASSWORD$
11025 IF QQ THEN _
LPRINT A$
11027 GOSUB 1405
RH = RET
IF OF < MINIMUM.LOGON.SECURITY THEN _
A$ = " <Locked out> " : _
GOTO 11030
IF OF >= SYSOP.SECURITY.LEVEL THEN _
A$ = " (SYSOP) " : _
GOTO 11030
A$ = SPACE$(19)
11030 A$ = A$ + _
LAST.DATE.TIME.ON$ + _
" " + _
CITY.STATE$ + _
MACHINE.TYPE$
11100 IF QQ THEN _
LPRINT A$
11101 GOSUB 1405
RH = RET
A$ = " DOWNLOADS = " + _
RIGHT$(" "+STR$(CVI(USER.DOWNLOADS$)),5)
A$ = FN S$(A$,22) + _
"UPLOADS = " + _
RIGHT$(" "+STR$(CVI(USER.UPLOADS$)),5)
A$ = FN S$(A$,40) + _
" Times on =" + _
RIGHT$(" "+STR$(CVI(MID$(USER.OPTIONS$,1,2))),5)
A$ = FN S$(A$,59) + _
"TIME USED = " + _
RIGHT$(" "+STR$(CVI(ELAPSED.TIME$)),5) + _
" Min"
IF QQ THEN _
LPRINT A$
11105 GOSUB 1405
IF STOP.INTERRUPTS THEN _
GOTO 11300
11110 A$ = "D)elete, F)ind, M)enu, N)ew pwd, P)rint, Q)uit, S)ecurity, #)user"
GOSUB 1500
IF NOT SCAN.USERS AND Q = 0 THEN _
GOTO 11310
11115 Z$ = FN UC$(LEFT$(B$(1),1))
X = INSTR("DNPQFSM",Z$)
IF Z$ = "" AND SCAN.USERS THEN _
GOTO 12965
ON X GOTO 11130,11160,11220,11320,11340,11390,11330
11125 Z = VAL(B$)
IF Z < 1 OR Z > HIGHEST.USER.RECORD-1 THEN _
GOTO 11310 _
ELSE GOTO 11010
'
' *****************************************************************************
' * D - COMMAND FROM 5- USER MAINTENANCE OPTIONS (DELETE USER) *
' *****************************************************************************
'
11130 LSET USER.NAME$ = "deleted user"
LSET SECURITY.LEVEL$ = MKI$(MINIMUM.LOGON.SECURITY -1)
LSET LAST.DATE.TIME.ON$ = "01/01/80" + " " + TIME.LOGGED.ON$
GOTO 11290
'
' *****************************************************************************
' * N - COMMAND FROM 5- USER MAINTENANCE OPTIONS (CHANGE USER PASSWORD) *
' *****************************************************************************
'
11160 GOSUB 12800
GOTO 11290
'
' *****************************************************************************
' * P - COMMAND FROM 5- USER MAINTENANCE OPTIONS (PRINT USER FILE) *
' *****************************************************************************
'
11220 QQ = NOT QQ
GOTO 11015
11290 USER.FILE.INDEX = LOC(2)
GOSUB 26500
PUT 2,USER.FILE.INDEX
GOSUB 27500
USER.FILE.INDEX = 0
GOTO 11015
11300 IF RH THEN _
GOTO 11330
11310 IF SCAN.USERS THEN _
GOTO 12965
11311 NEXT
'
' *****************************************************************************
' * Q - COMMAND FROM 5- USER MAINTENANCE OPTIONS (QUIT TO MAIN MENU) *
' *****************************************************************************
'
11320 CLOSE 2
USER.FILE.INDEX = TU
GOTO 20095
'
' *****************************************************************************
' * M - COMMAND FROM 5- USER MAINTENANCE OPTIONS (MAIN USER MAINT. MENU) *
' *****************************************************************************
'
11330 CLOSE 2
GOTO 11000
'
' *****************************************************************************
' * F - COMMAND FROM 5- USER MAINTENANCE OPTIONS (FIND USER) *
' *****************************************************************************
'
11340 A$ = "Full name to find"
GOSUB 1499
IF Q = 0 THEN _
GOTO 11340
TEMP.USER.NAME$ = FN UC$(B$(1))
IF LEN(TEMP.USER.NAME$) < 6 THEN _
GOTO 11340
GOSUB 12600
GOSUB 21995
USER.FILE.INDEX = 0
IF FOUND THEN _
GOTO 11015
11380 A$ = TEMP.USER.NAME$ + " not found"
GOSUB 1400
GOTO 11310
'
' *****************************************************************************
' * S - COMMAND FROM 5- USER MAINTENANCE OPTIONS (CHANGE USER SECURITY) *
' *****************************************************************************
'
11390 GOSUB 11395
LSET SECURITY.LEVEL$ = MKI$(OF)
GOTO 11290
11395 A$ = "Enter security level"
GOSUB 1500
Z$ = FN UC$(B$(1))
OF = VAL(Z$)
IF OF > USER.SECURITY.LEVEL THEN _
OF = USER.SECURITY.LEVEL
RETURN
'
' *****************************************************************************
' * A - COMMAND FROM 5- USER MAINTENANCE OPTIONS (ADD USER) *
' *****************************************************************************
'
12300 A1$ = ""
ATTEMPTS = 0
USER.SECURITY.LEVEL.SAVE = USER.SECURITY.LEVEL
FIRST.NAME.SAVE$ = FIRST.NAME$
LAST.NAME.SAVE$ = LAST.NAME$
ACTIVE.USER.NAME.SAVE$ = ACTIVE.USER.NAME$
CITY.STATE.SAVE$ = CI$
GOSUB 12500
TEMP.USER.NAME$ = ACTIVE.USER.NAME$
GOSUB 30500
GOSUB 12600
GOSUB 25000
IF USER.FILE.INDEX = 0 THEN _
GOTO 12320
IF FOUND THEN _
PRINT "User already exists" : _
GOSUB 27000 : _
GOTO 12320
12310 GOSUB 12630
GOSUB 12800
GOSUB 11395
TEMP.SECURITY.LEVEL = OF
GOSUB 12900
LSET LAST.DATE.TIME.ON$ = CURRENT.DATE$ + _
" " + _
TIME.LOGGED.ON$
GOSUB 12950
LSET CITY.STATE$ = FN UC$(B$(1))
LSET ELAPSED.TIME$ = MKI$(0)
PUT 2,USER.FILE.INDEX
12320 GOSUB 27500
USER.SECURITY.LEVEL = USER.SECURITY.LEVEL.SAVE
FIRST.NAME$ = FIRST.NAME.SAVE$
LAST.NAME$ = LAST.NAME.SAVE$
ACTIVE.USER.NAME$ = ACTIVE.USER.NAME.SAVE$
CI$ = CITY.STATE.SAVE$
USER.FILE.INDEX = TU
GOTO 11000
'
' *****************************************************************************
' * GET USER FIRST AND LAST NAMES *
' *****************************************************************************
'
12500 IF ATTEMPTS > 5 THEN _
FF = TRUE : _
RETURN
12510 GOSUB 12700
ATTEMPTS = ATTEMPTS + 1
A$ = A1$ + "FIRST Name"
GOSUB 1499
IF Q = 0 THEN _
GOTO 12500
Z$ = FN UC$(B$(1))
GOSUB 5100
FIRST.NAME$ = FN SS$(Z$)
IF Q = 1 THEN _
GOTO 12530
12520 Z$ = FN UC$(B$(2))
GOTO 12540
12530 A$ = A1$ + "LAST Name"
GOSUB 1500
Z$ = FN UC$(B$(1))
12540 GOSUB 5100
LAST.NAME$ = FN SS$(Z$)
IF LEN(FIRST.NAME$) < 2 OR _
LEN(LAST.NAME$) < 2 OR _
(LEN(FIRST.NAME$) + LEN(LAST.NAME$)) > 30 THEN _
GOTO 12500
12550 ACTIVE.USER.NAME$ = MID$(FIRST.NAME$ + " " + LAST.NAME$,1,31)
Z$ = FIRST.NAME$
RETURN
'
' *****************************************************************************
' * CHECK FOR NAMES NOT ALLOWED *
' *****************************************************************************
'
12570 FOUND = FALSE
SWAP TRASHCAN.FILE$,FILE.NAME$
GOSUB 58000
SWAP TRASHCAN.FILE$,FILE.NAME$
IF BADNEWS = 53 THEN _
GOTO 710
12580 IF EOF(2) THEN _
GOTO 1495
INPUT #2,INVALID.NAME$
IF Z$ <> INVALID.NAME$ THEN _
GOTO 12580
FOUND = TRUE
RETURN
12595 A$ = "Real name required. Call traced & recorded."
GOSUB 1405
GOTO 10698
'
' *****************************************************************************
' * COMMON SEARCH USER FILE ROUTINE *
' *****************************************************************************
'
12600 GOSUB 4910
GOSUB 26000
A$ = "Checking Users..."
GOSUB 1400
12605 GOSUB 9400
X$ = FN S$(TEMP.USER.NAME$,31)
DF = (ASC(MID$(TEMP.USER.NAME$,2,1))*10 + 7) MOD _
HIGHEST.USER.RECORD
USER.FILE.INDEX = _
((ASC(TEMP.USER.NAME$)*100 + _
ASC(MID$(TEMP.USER.NAME$,LEN(TEMP.USER.NAME$) / 2,1)) * _
10 + _
ASC(RIGHT$(TEMP.USER.NAME$,1))) _
MOD HIGHEST.USER.RECORD) + 1
IX = 0
12610 GET 2,USER.FILE.INDEX
IF X$ = USER.NAME$ THEN _
FOUND = TRUE : _
RETURN
IF USER.NAME$ = SPACE$(31) THEN _
IF CURRENT.USER.COUNT >= HIGHEST.USER.RECORD*.95 THEN _
Z$ = "No room for new users" + GRN$ : _
A$ = Z$ : _
GOSUB 13670 : _
GOSUB 1397 : _
USER.FILE.INDEX = 0 : _
FOUND = FALSE : _
RETURN _
ELSE USER.FILE.INDEX = IX-(IX = 0)*USER.FILE.INDEX : _
FOUND = FALSE : _
RETURN
IF ASC(USER.NAME$) = 0 OR LEFT$(USER.NAME$,7) = "NEWUSER" THEN _
IF IX = 0 THEN _
IX = USER.FILE.INDEX
12620 USER.FILE.INDEX = USER.FILE.INDEX + DF
IF USER.FILE.INDEX > HIGHEST.USER.RECORD-1 THEN _
USER.FILE.INDEX = USER.FILE.INDEX-HIGHEST.USER.RECORD
GOTO 12610
12630 GOSUB 23000
CURRENT.USER.COUNT = CURRENT.USER.COUNT-(IX = 0)
GOSUB 24000
GOSUB 25000
GOSUB 26500
GOSUB 27000
RETURN
'
' *****************************************************************************
' * INFORM USER OF WHAT CONFERENCE USER FILE HE IS VIEWING *
' *****************************************************************************
'
12700 IF CONFERENCE.MODE THEN _
A$ = "Users of " + GRN$ + ":" : _
GOSUB 1405
RETURN
'
' *****************************************************************************
' * GET PASSWORD FROM NEWUSER *
' *****************************************************************************
'
12800 A$ = "Enter PASSWORD you'll use to logon again"
GOSUB 1500
IF B$(1) = SPACE$(LEN(B$(1))) THEN _
GOTO 12800
IF LEN(B$(1)) > 15 THEN _
A$ = "15 Char. Max" : _
GOSUB 1405 : _
GOTO 12800
Z$ = FN UC$(B$(1))
LSET PASSWORD$ = Z$
RETURN
'
' *****************************************************************************
' * SET NEWUSER DEFAULTS *
' *****************************************************************************
'
12900 LSET USER.NAME$ = ACTIVE.USER.NAME$
LSET USER.OPTIONS$ = MKI$(0) + _
MKI$(0) + _
" 0" + _
MKI$(64) + _
MKI$(16) + _
MKI$(0) + _
CHR$(PAGE.LENGTH) + _
STRING$(1,0)
LSET USER.DOWNLOADS$ = MKI$(0)
LSET USER.UPLOADS$ = MKI$(0)
LSET SECURITY.LEVEL$ = MKI$(TEMP.SECURITY.LEVEL)
LSET ELAPSED.TIME$ = MKI$(0)
RETURN
'
' *****************************************************************************
' * GET MACHINE TYPE CALLING FROM *
' *****************************************************************************
'
12950 A$ = "What type of system are you calling from (Press [ENTER] if " + _
DEFAULT.MACHINE.TYPE$ + _
")"
GOSUB 1500
IF Q = 0 THEN _
LSET MACHINE.TYPE$ = DEFAULT.MACHINE.TYPE$ _
ELSE LSET MACHINE.TYPE$ = FN UC$(B$(1))
'
' *****************************************************************************
' * GET CITY AND STATE FROM NEWUSER *
' *****************************************************************************
'
12960 A$ = A1$ + "CITY and STATE"
GOSUB 1500
IF Q = 0 THEN _
GOTO 12960
LSET CITY.STATE$ = FN UC$(B$(1))
CI$ = FN UC$(B$(1)) + SPACE$(2)
RETURN
'
' *****************************************************************************
' * S - COMMAND FROM 5 - USER MAINTENANCE OPTIONS (SCAN USERS) *
' *****************************************************************************
'
12962 X = 0
FF = FALSE
A$ = "String to search (Press [ENTER] to quit)"
GOSUB 1500
IF Q = 0 THEN _
GOTO 11000
R$ = FN UC$(B$(1))
12963 GET 2,I
GOSUB 12966
X = INSTR(SCAN.FIELD$,R$)
IF X > 0 THEN _
GOTO 11015
IF I > HIGHEST.USER.RECORD-1 THEN _
GOTO 11000
12965 I = I + 1
X = 0
GOTO 12963
12966 FF = INSTR("NCPSL",SCAN.FUNCTION$)
IF FF = 0 THEN _
GOTO 11000
12967 ON FF GOTO 12968,12969,12970,12971,12972
'
' *****************************************************************************
' * N - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR NAME) *
' *****************************************************************************
'
12968 SCAN.FIELD$ = USER.NAME$
RETURN
'
' *****************************************************************************
' * C - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR CITY/ST) *
' *****************************************************************************
'
12969 SCAN.FIELD$ = CITY.STATE$
RETURN
'
' *****************************************************************************
' * P - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR PASSWORD)*
' *****************************************************************************
'
12970 SCAN.FIELD$ = PASSWORD$
RETURN
'
' *****************************************************************************
' * S - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR SYSTEM) *
' *****************************************************************************
'
12971 SCAN.FIELD$ = MACHINE.TYPE$
RETURN
'
' *****************************************************************************
' * L - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR LEVEL) *
' *****************************************************************************
'
12972 SCAN.FIELD$ = STR$(CVI(SECURITY.LEVEL$))
RETURN
'
' *****************************************************************************
' * MAIN SYSTEM ERROR TRAP - ALL ERRORS PASS THROUGH THIS ROUTINE *
' *****************************************************************************
'
13000 ' PRINT ERR,ERL
IF ERR = 7 THEN _
GOTO 13650
13010 IF ERL = 130 THEN _
CALLERS.FILE.INDEX = 1 : _
RESUME 135
13020 IF ERL = 230 AND (ERR = 24 OR ERR = 25 OR ERR = 27 OR ERR = 68) THEN _
PRINTER = FALSE : _
RESUME 230
13021 IF ERL = 275 AND ERR = 57 THEN _
LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
RESUME 275
13022 IF ERL = 324 AND ERR = 57 THEN _
LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
RESUME 324
13025 IF ERL = 677 AND ERR = 5 THEN _
RESUME 670
13033 IF ERL = 825 AND ERR = 5 THEN _
RESUME 830
13034 IF ERL = 836 AND (ERR = 24 OR ERR = 25 OR ERR = 27 OR ERR = 68) THEN _
PRINTER = FALSE : _
RESUME 836
13035 IF ERL = 954 AND ERR = 5 THEN _
HH = 1 : _
LINE.25$ = "" : _
RESUME 954
13036 IF ERL = 1420 AND ERR = 69 THEN _
GOSUB 13660 : _
RESUME 13540
13037 IF ERL = 1540 AND ERR = 57 THEN _
LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
RESUME 1540
13038 IF ERL = 4371 AND ERR = 6 THEN _
RESUME 1200
13045 IF ERL = 5130 AND ERR = 63 THEN _
RESUME 5160
13047 IF ERL = 5150 AND ERR = 62 THEN _
RESUME 5160
13050 IF ERL = 9400 AND ERR = 75 AND SHARE.IT THEN _
FOR I = 1 TO 10 : _
GOSUB 50510 : _
NEXT : _
RESUME 9400
13060 IF ERL = 11025 THEN _
QQ = 0 : _
RESUME 11025
13070 IF ERL = 11100 THEN _
QQ = 0 : _
RESUME 11100
13075 IF ERL = 12610 AND ERR = 63 THEN _
IF IX = 0 THEN _
IX = USER.FILE.INDEX : _
RESUME 12620 _
ELSE RESUME 12620
13080 IF ERL = 13674 THEN _
PRINTER = FALSE : _
RESUME 13674
13087 IF ERL = 20242 AND ERR = 62 THEN _
RESUME 20247
13090 IF ERR = 58 THEN _
GOTO 13130
13100 IF (ERR = EC AND (FN TI! - TKA! < 5)) THEN _
EA = EA + 1 : _
IF EA > 10 THEN _
GOTO 13800
13120 EC = ERR
IF FN TI! - TKA! > 5 THEN _
EA = 0 _
ELSE TKA! = FN TI!
13130 IF ERL = 117 AND ERR = 53 THEN _
DF$ = CONFIG.FILENAME$ : _
GOTO 13600
13135 IF ERL = 122 AND ERR = 62 THEN _
DF$ = CONFIG.FILENAME$ : _
GOTO 13600
13150 IF ERL = 346 THEN _
IF ERR = 53 THEN _
RESUME 400 _
ELSE IF ERR = 58 THEN _
RESUME 347
13180 IF ERL = 1420 AND ERR = 57 THEN _
LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
RESUME 1425
13190 IF ERL = 1540 OR _
ERL = 3737 OR _
ERL = 20840 OR _
ERL = 21281 OR _
ERL = 21360 OR _
ERL = 21420 THEN _
GOSUB 50500 : _
IF INP(MODEM.STATUS.REGISTER) < 128 THEN _
RESUME 10595
13200 IF ERL = 1540 THEN _
RESUME 1540
13220 IF ERL = 3737 THEN _
RESUME 3737
13230 IF ERL = 4797 THEN _
GOSUB 50500 : _
Z$ = A$ : _
GOSUB 13670 : _
IF INP(MODEM.STATUS.REGISTER) < 128 THEN _
RESUME 10595 _
ELSE RESUME 4797
13232 IF ERL = 4905 THEN _
IF ERR = 53 THEN _
RESUME 4910 _
ELSE IF ERR = 58 THEN _
RESUME 4906
13237 IF ERL = 5300 THEN _
IF ERR = 53 THEN _
A$ = "There are no Active Conferences available!" : _
GOSUB 1399 : _
RESUME 2210 _
ELSE RESUME 5310
13238 IF ERL = 5324 THEN _
IF ERR = 53 OR ERR = 64 THEN _
ACTIVE.MESSAGE.FILE$ = MAIN.MESSAGE.FILE$ : _
GRN$ = "" : _
RESUME 5312 _
ELSE RESUME 5325
13240 IF ERL = 5328 THEN _
IF ERR = 53 OR ERR = 64 THEN _
ACTIVE.USER.FILE$ = MAIN.USER.FILE$: _
UPDATE.DATE = FALSE : _
GOSUB 21990 : _
GET 1,1 : _
MID$(MESSAGE.RECORD$,57,5) = STR$(CURRENT.USER.COUNT) : _
MID$(MESSAGE.RECORD$,62,5) = STR$(HIGHEST.USER.RECORD) : _
PUT 1,1 : _
GOSUB 25000 : _
TIX = MAIN.USER.FILE.INDEX : _
RESUME 5345 _
ELSE RESUME 5330
13245 IF ERL = 5536 AND ERR = 57 THEN _
LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
RESUME 20015
13250 IF ERL = 5536 THEN _
RESUME 5530
13260 IF ERL = 7110 THEN _
RESUME 6080
13270 IF ERL = 7130 AND ERR = 52 THEN _
RESUME 7260
13280 IF ERL = 10601 AND ERR = 63 THEN _
GOTO 10595
13310 IF ERL = 10721 THEN _
IF ERR = 53 OR ERR = 64 THEN _
RESUME 1495
13312 IF ERL = 10986 AND ERR = 58 THEN _
RESUME 10987
13314 IF ERL = 10986 THEN _
A$ = "Door " + Z$ + " closed" + ". Please tell SYSOP" : _
GOSUB 1405 : _
RESUME 1200
13355 IF ERL = 20165 AND ERR = 58 THEN _
RESUME 20167
13357 IF ERL = 20165 THEN _
RESUME 20170
13360 IF ERL = 20221 AND ERR = 53 THEN _
RESUME 20225
13370 IF ERL = 20221 AND ERR = 58 THEN _
OK = TRUE : _
RESUME 20225
13372 IF (ERL = 20221 AND ERR = 64) OR _
(ERL = 20221 AND ERR = 75) THEN _
A$ = "Invalid file name" : _
GOSUB 1405 : _
RESUME 20200
13380 IF ERL = 20441 AND ERR = 58 THEN _
OK = FALSE : _
RESUME 20450
13383 IF (ERL = 20441 AND ERR = 64) OR _
(ERL = 20441 AND ERR = 75) THEN _
A$ = "Invalid file name" : _
GOSUB 1405 : _
RESUME 20420
13385 IF ERL = 20441 AND ERR = 53 THEN _
RESUME 20450
13390 IF ERL = 20450 THEN _
OK = FALSE : _
RESUME 20455
13400 IF ERL = 20620 THEN _
OK = FALSE : _
RESUME 20621
13402 IF ERL = 20661 AND ERR = 55 THEN _
RESUME 20662
13405 IF ERL = 20736 AND ERR = 53 THEN _
RESUME 1495
13410 IF ERL = 20840 THEN _
RESUME 20840
13420 IF ERL = 21130 THEN _
OK = FALSE : _
RESUME 21131
13430 IF ERL = 21281 THEN _
RESUME 21281
13440 IF ERL = 21360 THEN _
RESUME 21360
13442 IF ERL = 21420 THEN _
RESUME 21420
13443 IF ERL = 43031 AND ERR = 58 THEN _
OK = TRUE : _
RESUME 43032
13445 IF ERL = 43031 AND ERR = 53 THEN _
RESUME 43032
13446 IF ERL = 52001 AND ERR = 53 THEN _
IF Z$ = COMMENTS.FILE$ THEN _
CLOSE 2 : _
OPEN "O",2,COMMENTS.FILE$ : _
CLOSE 2 : _
RESUME 52000
13447 IF ERL = 52001 AND ERR = 53 THEN _
A$ = "Upload directory file missing. Please tell SYSOP" : _
GOSUB 1405 : _
RESUME 20015
13448 IF ERL = 58000 AND ERR = 52 THEN _
RESUME 58010
13449 IF ERL = 58020 AND ERR = 53 THEN _
BADNEWS = 53 : _
RESUME 58030
13450 IF 65535! = ERL THEN _
GOTO 13800
13460 IF ERR = 5 THEN _
GOTO 10595
13470 IF ERR = 57 OR ERR = 24 OR ERR = 25 THEN _
GOSUB 50500 : _
MODEM.STATUS = INP(MODEM.STATUS.REGISTER) : _
IF MODEM.STATUS < 128 THEN _
RESUME 10595
13480 IF ERR = 61 THEN _
A$ = "* Disk full - terminating *" : _
GOSUB 1399 : _
GOSUB 33090 : _
GOSUB 13660 : _
RESUME 13540
13490 IF ERR = 71 THEN _
GOSUB 13630 : _
RESUME 20015
13500 GOSUB 13660
A$ = A$ + ". Please tell SYSOP"
GOSUB 1405
RESUME 1200
'
' *****************************************************************************
' * COMMON EXIT FROM RBBS-PC (I.E. "ABANDON ALL HOPE OH YE WHO ENTER HERE") *
' *****************************************************************************
'
13540 IF LOCAL.USER THEN _
GOTO 13549
13543 IF NOT SYSOP THEN _
IF USER.FILE.INDEX = 0 OR NEW.USER = TRUE THEN _
GOTO 13549
13545 GOSUB 43050
13549 GOSUB 13700
GOSUB 13550
GOSUB 21990
GET 1,NODE.RECORD.INDEX
EXIT.TO.DOORS = FALSE
MID$(MESSAGE.RECORD$,57,1) = "I"
MID$(MESSAGE.RECORD$,40,2) = STR$(EXIT.TO.DOORS)
PUT 1,NODE.RECORD.INDEX
GOSUB 21996
CLOSE
GOSUB 50500
OPEN COM.PORT$+":"+MODEM.INIT.BAUD$+",N,8,1,RS,CD,DS" AS #3
A$=MODEM.RESET.COMMAND$
GOSUB 52070
GOSUB 50500
CLOSE
IF RECYCLE.TO.DOS THEN _
GOTO 31000 _
ELSE RUN 100
13550 IF LOCAL.USER THEN _
RETURN
13560 GOSUB 50510
OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) AND 254
GOSUB 50500
OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) OR 1
RETURN
13600 CLS
LOCATE ,,0
PRINT DF$;" file not found/invalid. Run CONFIG."
GOSUB 50510
GOTO 31000
13630 A$ = "File Menu not available."
GOSUB 1405
RETURN
13650 CLS
LOCATE ,,0
PRINT "Not enough memory for RBBS"
GOSUB 50510
GOTO 31000
13660 A$ = "+++ Error " + _
STR$(ERR) + _
" line " + _
STR$(ERL) + _
" at " + _
TIME$ + _
" on " + _
DATE$
Z$ = A$
GOTO 13666
'
' *****************************************************************************
' * EXTENDED LOGGING ENTRY *
' *****************************************************************************
'
13665 IF NOT EXTENDED.LOGGING THEN _
RETURN
13666 GOSUB 41510
Z$ = Z$ + " at " + TIM$
'
' *****************************************************************************
' * UPDATE CALLERS FILE WITH USER ACTIVITY *
' *****************************************************************************
'
13670 Z$ = SPACE$(5) + Z$
IF NOT LOCAL.USER THEN _
LSET CALLERS.RECORD$ = Z$ : _
CALLERS.FILE.INDEX = CALLERS.FILE.INDEX + 1 : _
PUT 4,CALLERS.FILE.INDEX
13674 IF PRINTER THEN _
LPRINT Z$
RETURN
13700 IF MESSAGE.FILE.LOCK THEN _
GOSUB 25000
13710 IF USER.FILE.LOCK THEN _
GOSUB 27000
13720 IF USER.BLOCK.LOCK THEN _
GOSUB 27500
RETURN
'
' *****************************************************************************
' * FATAL ERROR HAS OCCURED! RECYCLE SYSTEM IMMEDIATELY *
' *****************************************************************************
'
13800 A$ = "Fatal error!"
GOSUB 1405
GOTO 10595
'
' *****************************************************************************
' * TAKE THE PHONE OFF THE HOOK FOR LOCAL SYSOP MAINTENANCE *
' *****************************************************************************
'
14500 A$ = MODEM.GO.OFFHOOK.COMMAND$
GOSUB 52070
CLOSE 3
RETURN
'
' *****************************************************************************
' * *
' * FILES MENU PROCESSING *
' * *
' *****************************************************************************
'
20015 GOSUB 49000
ACTIVE.MENU$ = "F"
GOSUB 41050
NON.STOP = FALSE
IF NOT EXPERT.USER THEN _
FILE.NAME$ = MENU$(3) : _
GOSUB 43025
20030 A$ = GRN$ + " File Function <D,G,H,L,N,Q,S,U,X,?>"
GOSUB 1499
IF Q = 0 THEN _
GOTO 20015
20050 LIST.NEW = FALSE
Z$ = FN UC$(B$(1))
FF = INSTR("DGHLNQSUX?",Z$)
IF FF = 0 THEN _
J = 1 : _
GOSUB 1360 : _
GOTO 20015
IF USER.SECURITY.LEVEL < FILES.FUNCTION(FF) THEN _
VIOLATION$ = "File " + Z$ : _
GOSUB 1380 : _
GOTO 20015
20070 ON FF GOSUB 20180,20100,20110,20150,53000,20090,52900,20400,4240,20130
GOTO 20015
'
' *****************************************************************************
' * Q - COMMAND FROM FILES MENU (QUIT) *
' *****************************************************************************
'
20090 RETURN 20095
'
' *****************************************************************************
' * C/R - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (QUIT TO MAIN MENU)*
' *****************************************************************************
'
20093 IF USER.FILE.INDEX > 0 THEN _
GOSUB 9400 : _
GET 2,USER.FILE.INDEX : _
GOSUB 9500
20095 RETURN 1200
'
' *****************************************************************************
' * G - COMMAND FROM FILES MENU (GOODBYE) *
' *****************************************************************************
'
20100 RETURN 10560
'
' *****************************************************************************
' * H - COMMAND FROM FILES MENU (HELP) *
' *****************************************************************************
'
20110 FILE.NAME$ = HELP$(5)
GOSUB 1790
RETURN
'
' *****************************************************************************
' * ? - COMMAND FROM FILES MENU (EXTRA HELP) *
' *****************************************************************************
'
20130 FILE.NAME$ = HELP$(6)
GOSUB 1790
RETURN
'
' *****************************************************************************
' * L - COMMAND FROM FILES MENU (LIST DIRECTORY) *
' *****************************************************************************
'
20150 LIST.DIRECTORY = TRUE
IF Q < 2 THEN _
Q = 2 : _
B$(Q) = DIRECTORY.EXTENTION$
20160 X = 2
QX = Q
20161 IF X > QX THEN _
RETURN
IF INSTR(B$(X),".") THEN _
GOTO 20172
20162 FOR SUBDIR.INDEX = 1 TO SUBDIR.COUNT
FILE.NAME$ = SUBDIR$(SUBDIR.INDEX) + _
B$(X) + _
"." + _
DIRECTORY.EXTENTION$
GOSUB 43030
20165 NAME FILE.NAME$ AS FILE.NAME$
20167 IF LIST.NEW THEN _
GOSUB 7000 : _
GOTO 20175
GOSUB 6000
GOTO 20175
20170 NEXT
20172 A$ = "Directory " + B$(X) + " not found!"
GOSUB 1400
20175 X = X + 1
GOTO 20161
'
' *****************************************************************************
' * D - COMMAND FROM FILES MENU (SEARCH FOR FILE TO DOWNLOAD) *
' *****************************************************************************
'
20180 IF Q > 1 THEN _
B = 2 : _
GOTO 20202
20200 A$ = "Enter full filename to download"
GOSUB 1500
B = 1
IF Q = 0 THEN _
RETURN
20202 START.DRIVE = 1
IF Q > B THEN _
START.DRIVE = VAL(B$(B + 1)) : _
IF START.DRIVE < 1 THEN _
START.DRIVE = 1
20205 Z$ = B$(B)
VIOLATION$ = "Download "
FOR SUBDIR.INDEX = START.DRIVE TO (SUBDIR.COUNT) + (NOT SYSOP)
GOSUB 20741
ON BAD.FILE.NAME.INDEX GOTO 20220,20231
20220 OK = FALSE
20221 NAME FILE.NAME$ AS FILE.NAME$
20225 IF OK THEN _
GOTO 20235
20230 NEXT
20231 Z$ = B$(B) + " not found!"
GOSUB 13670
A$ = Z$ + " Type L for directory"
GOSUB 1400
RETURN 20015
'
' *****************************************************************************
' * TEST FOR SYSTEM FILE ATTEMPT *
' *****************************************************************************
'
20235 Z$ = FILE.NAME$
A$ = ACTIVE.MESSAGE.FILE$
GOSUB 43040
A$ = MAIN.MESSAGE.BACKUP$
GOSUB 43040
A$ = COMMENTS.FILE$
GOSUB 43040
A$ = ACTIVE.USER.FILE$
GOSUB 43040
A$ = ACTIVE.USER.FILE$ + ".BAK"
GOSUB 43040
A$ = CALLERS.FILE$
GOSUB 43040
A$ = RBBS.BAT$
GOSUB 43040
A$ = RCTTY.BAT$
GOSUB 43040
A$ = PASSWORDS.FILE$
GOSUB 43040
A$ = FILESEC.FILE$
GOSUB 43040
LINE.25$ = "(D) " + Z$
'
' *****************************************************************************
' * TEST FOR DOWNLOAD SECURITY *
' *****************************************************************************
'
SWAP FILESEC.FILE$,FILE.NAME$
GOSUB 58000
SWAP FILESEC.FILE$,FILE.NAME$
IF BADNEWS = 53 THEN _
Z$ = "Missing file " + FILESEC.FILE$ : _
GOSUB 13670 : _
GOTO 20247
N$ = Z$
GOSUB 20282
LG$(9) = DR$
LG$(8) = X$
LG$(10) = EXTENTION$
20242 IF EOF(2) THEN _
GOTO 20247 _
ELSE INPUT #2,N$,FILE.SECURITY,FILE.PASSWORD$ : _
GOSUB 20282
20243 IF DR$ <> "" AND DR$ <> LG$(9) THEN _
GOTO 20242
A$ = LG$(8)
Z$ = X$
GOSUB 20285
IF OK THEN _
GOTO 20242
A$ = LG$(10)
Z$ = EXTENTION$
GOSUB 20285
IF OK THEN _
GOTO 20242
20244 IF USER.SECURITY.LEVEL < FILE.SECURITY THEN _
GOTO 20245
IF FILE.PASSWORD$ = "" THEN _
GOTO 20247
FILE.PASSWORD$ = FN UC$(FILE.PASSWORD$)
IF FILE.PASSWORD$ = PASSWORD$ THEN _
GOTO 20247
A$ = "Enter PASSWORD for downloading " + FILE.NAME$
GOSUB 1500
IF Q = 0 THEN _
RETURN 20015 ' CPC141A4
IF FN UC$(B$(1)) = FILE.PASSWORD$ THEN _
GOTO 20247
20245 VIOLATION$ = "DownLoad " + FILE.NAME$
GOSUB 1380
RETURN 20015
20247 DF = 0
EXTENTION$ = RIGHT$(FILE.NAME$,4)
IF INSTR(".WRK.FW .ARC.EXE.COM.OBJ.WKS.LBR",EXTENTION$) OR _
MID$(EXTENTION$,3,1) = "Q" OR _
(REQUIRE.NON.ASCII AND EXTENTION$ = ".BAS") THEN _
A$ = "Non-ASCII transfer required" : _
GOSUB 1405 : _
DF = TRUE
20248 T$ = "Download" + TRANSFER.OPTIONS$
GOSUB 21620
IF FF THEN _
GOTO 20260
GOSUB 21600
20260 HH = 1
ON FF GOTO 20340,20262,20290,20290,1495
'
' *****************************************************************************
' * TEST FOR MNP PROTOCAL AVAILABLE *
' *****************************************************************************
'
20262 IF NOT MNP.SUPPORT THEN _
A$ = "MNP unavailable" : _
GOSUB 1405 : _
ON HH GOTO 1495,1495
LL = HH*HH
LL = LL-HH
GOSUB 20264
ON LL + HH GOTO 20385,20266,20660,20730
STOP
'
' *****************************************************************************
' * MNP INTERFACE FOR DOWNLOADS & UPLOADS *
' *****************************************************************************
'
20264 CLOSE 3
OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) OR 1
CALL MNP(HH,FILE.NAME$,COM.PORT$,BPS)
OPEN COM.PORT$ + _
":" + _
MID$(" 300 45012002400",(-4*BPS),4) + _
"," + _
MID$("N,8,1E,7,",6 + 5*EIGHT.BIT,4) + _
"1,RS,CD,DS" AS 3
RETURN
'
' *****************************************************************************
' * DOWNLOAD ABORT *
' *****************************************************************************
'
20266 A$ = "<Download aborted>"
DOWNLOAD.COMPLETED = FALSE
GOTO 20390
20282 Z$ = FN UC$(N$)
IF MID$(Z$,2,1) = ":" THEN _
DR$ = LEFT$(Z$,1) : _
S = 3 _
ELSE DR$ = "" : _
S = 1
20283 XXX = INSTR(Z$ + ".",".")
X$ = MID$(Z$,S,XXX-S)
EXTENTION$ = MID$(Z$,XXX + 1,3)
RETURN
20285 OK = FALSE
K = 0
L = LEN(A$)
20286 K = K + 1
IF K > L THEN _
GOTO 20288
B$ = MID$(Z$,K,1)
IF B$ = "*" THEN _
RETURN
20287 IF B$ <> "?" AND MID$(A$,K,1) <> B$ THEN _
OK = TRUE : _
RETURN
GOTO 20286
20288 IF L < LEN(Z$) AND MID$(Z$,L + 1,1) <> "*" THEN _
OK = TRUE
RETURN
'
' *****************************************************************************
' * XMODEM DOWNLOAD DRIVER *
' *****************************************************************************
'
20290 CLOSE 2
IF SHARE.IT THEN _
OPEN FILE.NAME$ FOR RANDOM SHARED AS #2 LEN=128 _
ELSE OPEN "R",2,FILE.NAME$,128
TLA = 165
GOSUB 20750
A1$ = "SEND"
GOSUB 20320
GOSUB 21300
A$ = ""
GOTO 20390
20320 IF NOT EIGHT.BIT THEN _
A$ = "Please SWITCH to N,8,1 for binary transfer" : _
GOSUB 1398 : _
GOSUB 50510
20325 XMODEM.TYPE$ = " ": _
NEGATIVE.ACKNOWLEDGE$ = CHR$(21): _
SOL = 132
IF FT$ = "C" THEN _
NEGATIVE.ACKNOWLEDGE$ = FT$: _
SOL = 133: _
XMODEM.TYPE$ = "/CRC "
20330 A$ = "XMODEM" + _
XMODEM.TYPE$ + _
A1$ + _
" ready. <Ctrl X> aborts"
GOSUB 1405
RETURN
'
' *****************************************************************************
' * ASCII DOWNLOAD DRIVER *
' *****************************************************************************
'
20340 IF DF THEN _
A$ = "Switch to XMODEM or MNP" : _
GOSUB 1405 : _
GOTO 20015
GOSUB 58000
TLA = 139
GOSUB 20750
A$ = "* <Ctrl X> aborts <Ctrl S> suspends *"
GOSUB 1400
A$ = "ASCII SEND ready. Press [ENTER] to start"
GOSUB 1500
20380 STOP.INTERRUPTS = TRUE
GOSUB 6030
IF RET THEN _
A$ = "<*>Download aborted<*>" : _
DOWNLOAD.COMPLETED = FALSE : _
GOTO 20390
20381 A$ = CHR$(26)
GOSUB 1400
IF NOT LOCAL.USER AND INP(MODEM.STATUS.REGISTER) > 127 THEN _
FOR X = 1 TO 5 : _
PRINT #3,CHR$(7) : _
GOSUB 50510 : _
NEXT
20385 A$ = "<End of file>"
DOWNLOAD.COMPLETED = TRUE
20390 GOSUB 1400
GOTO 50600
'
' *****************************************************************************
' * U - COMMAND FROM FILES MENU (UPLOAD) *
' *****************************************************************************
'
20400 GOSUB 41010
Q! = TCA!
IF Q > 1 THEN _
B$(1) = B$(2) : _
GOTO 20430
20420 A$ = "Enter full filename to upload"
GOSUB 1500
IF Q = 0 THEN _
RETURN
'
' *****************************************************************************
' * SEARCH FOR DUPLICATE FILENAME *
' *****************************************************************************
'
20430 Z$ = B$(1)
VIOLATION$ = "Upload "
FOR SUBDIR.INDEX = 1 TO SUBDIR.COUNT
GOSUB 20741
ON BAD.FILE.NAME.INDEX GOTO 20440,20420
20440 OK = TRUE
20441 NAME FILE.NAME$ AS FILE.NAME$
20450 IF OK THEN _
GOTO 20455
20451 IF USER.SECURITY.LEVEL >= OVERWRITE.SECURITY.LEVEL THEN _
A$ = "Overwrite file" : _
GOSUB 1500 : _
IF YES THEN _
Z$ = FILE.NAME$ : _
GOTO 20475
20453 CLOSE 2
A$ = Z$ + " exists! Please use a new file name"
GOSUB 1400
GOTO 20420
20455 NEXT
FILE.NAME.HOLD$ = Z$
Z$ = UPLOAD.DIRECTORY$
20475 GOSUB 1400
GOSUB 52000
A$ = "Upload disk has" + FREE.SPACE$
GOSUB 1400
LINE.25$ = "(U) " + FILE.NAME.HOLD$
GOSUB 950
T$ = "Upload" + TRANSFER.OPTIONS$
IF NOT OK THEN _
KILL FILE.NAME$ : _
OK = TRUE
20477 GOSUB 21620
IF FF THEN _
GOTO 20500
GOSUB 21600
20500 HH = 2
ON FF GOTO 20560,20262,20540,20540,20735
20510 IF SNOOP THEN _
PRINT "<Esc> by SYSOP aborts transfer"
RETURN
'
' *****************************************************************************
' * XMODEM UPLOAD DRIVER *
' *****************************************************************************
'
20540 A1$ = "RECEIVE"
GOSUB 20320
OK = TRUE
GOSUB 20860
IF OK THEN _
BLOCKS.IN.FILE# = (CDBL(LOC(2))*128#) : _
GOTO 20700
GOTO 20730
'
' *****************************************************************************
' * ASCII UPLOAD *
' *****************************************************************************
'
20560 A$ = "Transfer MUST end with a <Ctrl-K>"
GOSUB 1400
A$ = "ASCII RECEIVE ready"
GOSUB 1405
OK = FALSE
XOFF = FALSE
CLOSE 2
OPEN "O",2,FILE.NAME$
GOSUB 20510
20600 WHILE NOT EOF(3)
GOSUB 42000
IF LOF(3) < 512 AND INP(MODEM.STATUS.REGISTER) >127 THEN _
PRINT #3,XOFF$; : _
XOFF = TRUE
20610 X$ = INPUT$(LOC(3),3)
IF INSTR(X$,CHR$(11)) THEN _
GOTO 20650
OK = TRUE
20620 PRINT #2,X$;
IF SNOOP THEN _
PRINT X$;
20621 GOSUB 60000
IF KEY.PRESSED$ = ESCAPE$ THEN _
GOTO 20745
IF NOT OK THEN _
GOTO 20670
20630 WEND
GOSUB 42000
IF XOFF AND INP(MODEM.STATUS.REGISTER) > 127 THEN _
XOFF = FALSE : _
PRINT #3,XON$;
GOTO 20600
20650 X = INSTR(X$,CHR$(11))
IF X <> 1 THEN _
PRINT #2,LEFT$(X$,X-1) _
ELSE IF NOT OK THEN _
GOTO 20730
20660 A$ = "Upload complete"
GOSUB 1405
20661 OPEN "A",2,FILE.NAME$
20662 BLOCKS.IN.FILE# = (CDBL(LOC(2))*128#) + 128
GOTO 20700
20670 A$ = XOFF$ + "System error! Upload aborted <Ctrl-K> continues"
20675 GOSUB 1405
GOSUB 50510
IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,XON$;
20680 WHILE NOT EOF(3)
X$ = INPUT$(LOC(3),3)
IF INSTR(X$,CHR$(11)) THEN _
GOTO 20730
20685 GOSUB 42000
WEND
GOTO 20680
'
' *****************************************************************************
' * UPDATE UPLOAD DIRECTORY *
' *****************************************************************************
'
20700 BX = &H4
EN$ = UPLOAD.DIRECTORY$
GOSUB 29000
CLOSE 2
IF SHARE.IT THEN _
OPEN UPLOAD.DIRECTORY$ FOR APPEND SHARED AS #2 _
ELSE OPEN "A",2,UPLOAD.DIRECTORY$
BX = &H4
EN$ = UPLOAD.DIRECTORY$
GOSUB 29500
20710 A$ = "Describe " + _
FILE.NAME.HOLD$ + _
" (/ if for SYSOP only)" + _
RETURN.LINE.FEED$ + _
" |----+---1+0---+---2+0---+---3+0---+---4+0"
GOSUB 1398
GOSUB 1500
IF LEN(B$(1)) > 40 THEN _
GOTO 20710
20720 IF LEFT$(B$(1),1) = "/" THEN _
GOTO 20725
PRINT #2,USING "\ \######## & &"; _
FILE.NAME.HOLD$; _
BLOCKS.IN.FILE#; _
LEFT$(DATE$ ,6) + _
RIGHT$(DATE$ ,2); _
B$(1)
20725 CLOSE 2
Y$ = " >> uploaded << "
UPLOADS = UPLOADS + 1
GOSUB 41010
SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + _
UPLOAD.TIME.FACTOR! * _
(TCA!-Q!)
GOTO 50610
20730 A$ = "Upload aborted"
GOSUB 1405
20735 CLOSE 2
20736 KILL FILE.NAME$
RETURN
'
' *****************************************************************************
' * TEST FOR INVALID CHARACTERS IN FILENAME *
' *****************************************************************************
'
20741 BAD.FILE.NAME.INDEX = 1
Z$ = FN UC$(Z$)
FILE.NAME$ = SUBDIR$(SUBDIR.INDEX) + Z$
IF INSTR(FILE.NAME$,"?") OR _
INSTR(FILE.NAME$,"*") OR _
INSTR(FILE.NAME$," ") OR _
INSTR(3,FILE.NAME$,":") OR _
INSTR(FILE.NAME$,".DEF") OR _
INSTR(FILE.NAME$,".OLD") OR _
MID$(FILE.NAME$,LEN(FILE.NAME$),1) = "." THEN _
BAD.FILE.NAME.INDEX = 2 : _
RETURN
20742 IF LEN(Z$) >= 3 THEN _
IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:PRN:CON:AUX",Z$) THEN _
VIOLATIONS.THIS.SESSION = MAXIMUM.VIOLATIONS : _
VIOLATION$ = VIOLATION$ + Z$ : _
GOSUB 1380
20743 RETURN
'
' *****************************************************************************
' * SYSOP ABORTED UPLOAD *
' *****************************************************************************
'
20745 A$ = XOFF$ + "SYSOP aborted upload. Stop tranfer. <Ctrl-K> continues"
GOTO 20675
'
' *****************************************************************************
' * CALCULATE DOWNLOAD TIME ESTIMATE *
' *****************************************************************************
'
20750 IX# = FIX(LOF(2) / 128)
BLOCKS.IN.FILE# = LOF(2) / 128
IF IX# <> BLOCKS.IN.FILE# THEN _
BLOCKS.IN.FILE# = BLOCKS.IN.FILE# + 1
20780 A$ = STR$(INT(BLOCKS.IN.FILE#)) + " blocks in file"
GOSUB 1405
BLOCKS.IN.FILE# = BLOCKS.IN.FILE# * _
TLA / _
VAL(MID$("00030045120240",-3*BPS,3))
IF LOF(2) < 1 THEN _
GOTO 20015
20790 GOSUB 950
A$ = "Transfer time:" + _
STR$(INT(BLOCKS.IN.FILE# / 60)) + _
" minutes," + STR$(BLOCKS.IN.FILE# MOD 60) + _
" seconds"
GOSUB 1405
GOSUB 41000
IF (INT(BLOCKS.IN.FILE# / 60) + 1) > INT(TIME.REMAINING!) THEN _
A$ = "Not enough time left!" : _
Z$ = FILE.NAME$ + " " + A$ : _
GOSUB 1405 : _
GOSUB 13670 : _
GOTO 20015 _
ELSE RETURN
20810 GOSUB 42000
Y$ = ""
DELAY! = FN TI! + 2
20840 IF NOT EOF(3) THEN _
Y$ = INPUT$(LOC(3),3) : _
RETURN
20850 IF FN TI! < DELAY! THEN _
GOTO 20840
Y$ = ""
RETURN
'
' *****************************************************************************
' * XMODEM UPLOAD *
' *****************************************************************************
'
20860 GOSUB 20992
IF NOT EIGHT.BIT THEN _
GOSUB 21280
20900 X$ = ""
SEC = 1
CLOSE 2
OPEN "R",2,FILE.NAME$,128
FIELD 2,128 AS Z$
IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,NEGATIVE.ACKNOWLEDGE$;
TRANSFER.ABORT! = FN TI! + WAIT.BEFORE.DISCONNECT
20920 FOR X = 1 TO 5
GOSUB 60000
IF KEY.PRESSED$ = ESCAPE$ THEN _
GOTO 21270
GOSUB 20810
20930 IF LEFT$(Y$,1) = START.OF.HEADER$ THEN _
GOTO 21020
20940 IF LEFT$(Y$,1) = END.TRANSMISSION$ THEN _
GOTO 21220
20950 IF LEFT$(Y$,1) = CANCEL$ THEN _
GOTO 21230
20960 IF Y$ <> "" THEN _
GOSUB 21280 : _
IF FN TI! < TRANSFER.ABORT! THEN _
GOTO 20920 _
ELSE GOTO 21230
20970 NEXT
IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,NEGATIVE.ACKNOWLEDGE$;
IF SNOOP THEN _
PRINT "Upload Timeout"
IF FN TI! > TRANSFER.ABORT! THEN _
GOTO 21230
20990 GOTO 20920
'
' *****************************************************************************
' * CHANGE TO 8 BIT FOR XMODEM *
' *****************************************************************************
'
20992 GOSUB 20510
IF NOT EIGHT.BIT THEN _
GOSUB 50510 : _
OUT LINE.CONTROL.REGISTER,3
20996 SO = 0
RETURN
'
' *****************************************************************************
' * XMODEM UPLOAD *
' *****************************************************************************
'
21000 GOSUB 20810
IF Y$ = "" THEN _
PRINT "Upload Timeout" : _
GOTO 21040
21020 X$ = X$ + Y$
IF LEN(X$) < SOL THEN _
GOTO 21000
21040 IF LEN(X$) = SOL THEN _
GOTO 21090
21050 IF LEN(X$) > SOL THEN _
GOTO 21180
21060 IF X$ = END.TRANSMISSION$ THEN _
GOTO 21220
21070 IF X$ = CANCEL$ THEN _
GOTO 21230
21080 GOTO 21170
21090 IF SEC <> ASC(MID$(X$,2,1)) THEN _
GOTO 21200
21100 IF (SEC XOR 255) <> ASC(MID$(X$,3,1)) THEN _
GOTO 21210
21110 IF FT$ = "X" THEN _
WK$ = MID$(X$,4,128): _
GOSUB 46000 _
ELSE WK$ = MID$(X$,4): _
GOSUB 46000
21112 IF FT$ = "X" THEN _
IF XMODEM.CHECKSUM <> ASC(MID$(X$,132,1)) THEN _
GOTO 21190 _
ELSE 21120
21113 IF CRC.VALUE <> 0 THEN _
GOTO 21191
21120 SO = SO + 1
21130 IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,ACKNOWLEDGE$;
21131 LSET Z$ = MID$(X$,4)
PUT 2
IF NOT OK THEN _
GOTO 21230
21145 SEC = 255 AND (SEC + 1)
IF SNOOP THEN _
LOCATE ,1 : _
PRINT "Verified Rec Blk #";SO;
21150 X$=""
XMODEM.CHECKSUM = 0
TRANSFER.ABORT! = FN TI! + 30
GOTO 20920
21170 A$ = "Short Blk in #"
GOTO 21212
21180 A$ = "Long Blk in #"
GOTO 21212
21190 A$ = "Checksum Error in #"
GOTO 21212
21191 A$="CRC Error": _
GOTO 21212
21200 A$ = "Blk # Error in #"
IF SEC-1 <> ASC(MID$(X$,2,1)) THEN _
GOTO 21212
IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,ACKNOWLEDGE$;
GOTO 21150
21210 A$ = "Complement Error in #"
21212 IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,NEGATIVE.ACKNOWLEDGE$;
IF SNOOP THEN _
PRINT LINE.FEED$;A$;SO + 1
GOTO 21150
21220 IF SNOOP THEN _
PRINT LINE.FEED$;"File Closed"
21225 IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,ACKNOWLEDGE$;
GOTO 21250
21230 IF SNOOP THEN _
PRINT LINE.FEED$;"Transfer Aborted"
21240 OK = FALSE
IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,CANCEL$;CANCEL$;
21250 IF NOT EIGHT.BIT THEN _
EIGHT.BIT = TRUE
RETURN
21270 GOSUB 20510
GOSUB 21280
GOTO 21230
'
' *****************************************************************************
' * CLEAR GARBAGE OUT OF COMMUNICATIONS BUFFER *
' *****************************************************************************
'
21280 WHILE NOT EOF(3)
GOSUB 42000
21281 DF$ = INPUT$(LOC(3),3)
WEND
RETURN
'
' *****************************************************************************
' * XMODEM DOWNLOAD *
' *****************************************************************************
'
21300 GOSUB 20992
SEC = 0
GOSUB 21280
FIELD 2,128 AS X$
NEGATIVE.ACKNOWLEDGE$=CHR$(21)
TRANSFER.ABORT! = FN TI! + WAIT.BEFORE.DISCONNECT
21350 WHILE NOT EOF(3)
21360 Y$ = INPUT$(1,3)
IF Y$ = CANCEL$ THEN _
GOTO 21560
21380 IF Y$ = NEGATIVE.ACKNOWLEDGE$ THEN _
FF = 3: _
FT$ = "X": _
GOTO 21480 _
ELSE IF Y$ = "C" THEN _
FF = 4: _
FT$ = "C": _
GOTO 21480
21390 WEND
GOSUB 21460
IF FN TI! < TRANSFER.ABORT! THEN _
GOTO 21350
GOTO 21455
21410 TRANSFER.ABORT! = FN TI! + WAIT.BEFORE.DISCONNECT
21415 WHILE NOT EOF(3)
21420 Y$ = INPUT$(1,3)
IF Y$ = ACKNOWLEDGE$ THEN _
GOTO 21470
21440 IF Y$ <> NEGATIVE.ACKNOWLEDGE$ THEN _
GOTO 21450
21443 IF SNOOP THEN _
PRINT LINE.FEED$;"Error -> retrans #";SO
21445 SO = SO-1
GOTO 21490
21450 IF Y$ = CANCEL$ THEN _
GOTO 21560
IF FN TI! > TRANSFER.ABORT! THEN _
GOTO 21455
21451 WEND
GOSUB 21460
IF FN TI! < TRANSFER.ABORT! THEN _
GOTO 21410
21455 IF SNOOP THEN _
PRINT "Download timeout"
GOTO 21560
21460 GOSUB 42000
GOSUB 60000
IF KEY.PRESSED$ = ESCAPE$ THEN _
RETURN 21540
RETURN
21470 IF SNOOP THEN _
LOCATE ,1 : PRINT "Verified Sent Block #";SO;
21480 IF LOC(2) < LOF(2) / 128 THEN _
GET 2 : _
SEC = 255 AND (SEC + 1) : _
GOTO 21490
21482 IF SNOOP THEN _
PRINT LINE.FEED$;"End of file"
21485 GOTO 21530
21490 SO = SO + 1
IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,START.OF.HEADER$; CHR$(SEC); CHR$(SEC XOR 255);X$;
21503 IF FT$ = "X" THEN _
WK$=X$ _
ELSE WK$ = X$ + CHR$(0) + CHR$(0)
21504 GOSUB 46000
21510 IF FT$ = "X" AND INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT#3,CHR$(XMODEM.CHECKSUM); _
ELSE IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT#3,CHR$(CRC.HIGH);CHR$(CRC.LOW);
GOSUB 21280
GOTO 21410
'
' *****************************************************************************
' * END-OF-FILE FOR XMODEM DOWNLOADS -- SEND THE "EOT" CHARACTER AND WAIT UP *
' * TO 2 SECONDS FOR A POSITIVE RESPONSE (I.E. AN "ACK"). IF NONE IS *
' * RE-TRY UP TO 10 TIMES. IF NO POSITIVE RESPONSE IS RECEIVED AFTER TEN *
' * ATTEMPTS, ASSUME THE DOWNLOAD WAS UNSUCCESSFULL. *
' *****************************************************************************
'
21530 IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,END.TRANSMISSION$;
FOR X = 1 TO 10
GOSUB 20810
IF INSTR(Y$,ACKNOWLEDGE$) THEN _
GOTO 21550
GOSUB 60000
IF KEY.PRESSED$ = ESCAPE$ THEN _
GOTO 21540
21535 NEXT
DOWNLOAD.COMPLETED = FALSE
GOTO 21230
21540 GOSUB 20510
21545 Y$ = CANCEL$
IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,CANCEL$;CANCEL$;
DOWNLOAD.COMPLETED = FALSE
GOTO 21250
21550 DOWNLOAD.COMPLETED = TRUE
GOTO 21250
21560 DOWNLOAD.COMPLETED = FALSE
IF SNOOP THEN _
PRINT LINE.FEED$;"Receiver aborted transfer"
GOTO 21545
'
' *****************************************************************************
' * MANUAL SELECT OF TRANSFER PROTOCAL *
' *****************************************************************************
'
21600 CR = 0
A$ = T$
GOSUB 1500
IF Q = 0 THEN _
GOTO 21600
Z$ = B$(1)
'
' *****************************************************************************
' * DEFAULT SELECT OF TRANSFER PROTOCAL *
' *****************************************************************************
'
21610 Z$ = FN UC$(Z$)
FF = INSTR("AMXCQ",Z$)
IF FF < 1 OR (FF = 2 AND NOT MNP.SUPPORT) THEN _
GOTO 21600
FT$ = MID$("AMXC ",FF,1)
RETURN
21620 FF = -1
IF Q > 2 THEN _
Z$ = B$(3) : _
GOTO 21610
IF USER.TRANSFER.DEFAULT$ > " " THEN _
Z$ = USER.TRANSFER.DEFAULT$ : _
GOTO 21610
FF = 0
RETURN
'
' *****************************************************************************
' * LOCK AND OPEN MESSAGES FILE *
' *****************************************************************************
'
21990 GOSUB 22000
GOSUB 30500
RETURN
'
' *****************************************************************************
' * UNLOCK USERS AND MESSAGES *
' *****************************************************************************
'
21995 GOSUB 27000
GOSUB 25000
RETURN
'
' *****************************************************************************
' * FLUSH MESSAGE RECORD TO DISK AND UNLOCK MESSAGES *
' *****************************************************************************
'
21996 GOSUB 30000
GOSUB 25000
RETURN
'
' *****************************************************************************
' * LOCK USER FILE BLOCK OF 4 RECORDS AND OPEN USER FILE *
' *****************************************************************************
'
21997 GOSUB 26500
GOSUB 9400
RETURN
'
' *****************************************************************************
' * LOCK MESSAGE FILE *
' *****************************************************************************
'
22000 MESSAGE.FILE.LOCK = TRUE
MID$(LOCK.STATUS$,1,2) = "LM"
GOSUB 950
LOCK.FILE.NAME$ = ACTIVE.MESSAGE.FILE$
ON NETWORK.TYPE GOTO 22100,22200,22300
RETURN
'
' *****************************************************************************
' * LOCK MESSAGE FILE (MULTI-LINK) *
' *****************************************************************************
'
22100 AX = &H0
BX = &H1
GOSUB 60510
RETURN
'
' *****************************************************************************
' * LOCK MESSAGE FILE (OMNINET) *
' *****************************************************************************
'
22200 CC$ = CHR$(1) + MID$(ACTIVE.MESSAGE.FILE$ + SPACE$(8),3,8)
GOSUB 28000
IF CT = 0 THEN _
RETURN
GOSUB 50500
GOTO 22200
'
' *****************************************************************************
' * LOCK MESSAGE FILE (ORCHID PC-NET) *
' * LOCK USER FILE (ORCHID PC-NET) *
' * LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (ORCHID PC-NET) *
' *****************************************************************************
'
22300 GOSUB 28100
CALL LPLKIT(LOCK.DRIVE,LOCK.FILE.NAME$,A)
RETURN
'
' *****************************************************************************
' * GET MESSAGE HEADER RECORD DATA *
' *****************************************************************************
'
23000 GET 1,1
HIGH.MESSAGE.NUMBER = VAL(LEFT$(MESSAGE.RECORD$,8))
CALLS.TODATE! = VAL(MID$(MESSAGE.RECORD$,11,10))
CURRENT.USER.COUNT = VAL(MID$(MESSAGE.RECORD$,57,5))
HIGHEST.USER.RECORD = VAL(MID$(MESSAGE.RECORD$,62,5))
FIRST.MESSAGE.RECORD = VAL(MID$(MESSAGE.RECORD$,68,7))
NEXT.MESSAGE.RECORD = VAL(MID$(MESSAGE.RECORD$,75,7))
HIGHEST.MESSAGE.RECORD = VAL(MID$(MESSAGE.RECORD$,82,7))
NODES.IN.SYSTEM = VAL(MID$(MESSAGE.RECORD$,127))
IF NOT SYSOP AND NOT LOCAL.USER THEN RETURN
IF LAST.MESSAGE.READ < VAL(MID$(MESSAGE.RECORD$,123,4)) THEN _
LAST.MESSAGE.READ = VAL(MID$(MESSAGE.RECORD$,123,4))
LAST.MESSAGE.READ = - LAST.MESSAGE.READ * _
(LAST.MESSAGE.READ <= HIGH.MESSAGE.NUMBER)
RETURN
'
'
' *****************************************************************************
' * UPDATE MESSAGE HEADER RECORD DATA *
' *****************************************************************************
'
24000 MID$(MESSAGE.RECORD$,1,8) = STR$(HIGH.MESSAGE.NUMBER)
MID$(MESSAGE.RECORD$,11,10) = STR$(CALLS.TODATE!)
MID$(MESSAGE.RECORD$,57,5) = STR$(CURRENT.USER.COUNT)
MID$(MESSAGE.RECORD$,62,5) = STR$(HIGHEST.USER.RECORD)
MID$(MESSAGE.RECORD$,68,7) = STR$(FIRST.MESSAGE.RECORD)
MID$(MESSAGE.RECORD$,75,7) = STR$(NEXT.MESSAGE.RECORD)
MID$(MESSAGE.RECORD$,82,7) = STR$(HIGHEST.MESSAGE.RECORD)
PUT 1,1
RETURN
'
' *****************************************************************************
' * UNLOCK MESSAGE FILE *
' *****************************************************************************
'
25000 MESSAGE.FILE.LOCK = FALSE
MID$(LOCK.STATUS$,1,2) = "UM"
GOSUB 950
LOCK.FILE.NAME$ = ACTIVE.MESSAGE.FILE$
ON NETWORK.TYPE GOTO 25100,25200,25300
RETURN
'
' *****************************************************************************
' * UNLOCK MESSAGE FILE (MULTI-LINK) *
' *****************************************************************************
'
25100 AX = &H100
BX = &H1
GOSUB 60510
RETURN
'
' *****************************************************************************
' * UNLOCK MESSAGE FILE (OMNINET) *
' *****************************************************************************
'
25200 CC$ = CHR$(17) + MID$(ACTIVE.MESSAGE.FILE$ + SPACE$(8),3,8)
GOSUB 28000
IF CT = 128 THEN _
RETURN
GOSUB 50500
GOTO 25200
'
' *****************************************************************************
' * UNLOCK MESSAGE FILE (ORCHID PC-NET) *
' * UNLOCK USER FILE (ORCHID PC-NET) *
' * UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (ORCHID PC-NET) *
' *****************************************************************************
'
25300 GOSUB 28100
CALL UNLOKIT(LOCK.DRIVE,LOCK.FILE.NAME$,A)
RETURN
'
' *****************************************************************************
' * LOCK USER FILE *
' *****************************************************************************
'
26000 USER.FILE.LOCK = TRUE
MID$(LOCK.STATUS$,4,2) = "LU"
GOSUB 950
LOCK.FILE.NAME$ = ACTIVE.USER.FILE$
ON NETWORK.TYPE GOTO 26100,26200,22300
RETURN
'
' *****************************************************************************
' * LOCK USER FILE (MULTI-LINK) *
' *****************************************************************************
'
26100 AX = &H0
BX = &H2
GOSUB 60510
RETURN
'
' *****************************************************************************
' * LOCK USER FILE (OMNINET) *
' *****************************************************************************
'
26200 CC$ = CHR$(1) + MID$(ACTIVE.USER.FILE$ + SPACE$(8),3,8)
GOSUB 28000
IF CT = 0 THEN _
RETURN
GOSUB 50500
GOTO 26200
'
' *****************************************************************************
' * LOCK 4 RECORD BLOCK IN USER FILE *
' *****************************************************************************
'
26500 USER.BLOCK.LOCK = TRUE
BLK = (USER.FILE.INDEX / 4) + .26
MID$(LOCK.STATUS$,7,2) = "LB"
GOSUB 950
ON NETWORK.TYPE GOTO 26600,26700,26800
RETURN
'
' *****************************************************************************
' * LOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK) *
' *****************************************************************************
'
26600 AX = &H0
BX = BLK + 10
GOSUB 60510
RETURN
'
' *****************************************************************************
' * LOCK 4 RECORD BLOCK IN USER FILE (OMNINET) *
' *****************************************************************************
'
26700 CC$ = CHR$(1) + FN BL$
GOSUB 28000
IF CT = 0 THEN _
RETURN
GOSUB 50500
GOTO 26700
'
' *****************************************************************************
' * LOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET) *
' *****************************************************************************
'
26800 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + FN BL$
GOTO 22300
'
' *****************************************************************************
' * UNLOCK USER FILE *
' *****************************************************************************
'
27000 USER.FILE.LOCK = FALSE
MID$(LOCK.STATUS$,4,2) = "UU"
GOSUB 950
LOCK.FILE.NAME$ = ACTIVE.USER.FILE$
ON NETWORK.TYPE GOTO 27100,27200,25300
RETURN
'
' *****************************************************************************
' * UNLOCK USER FILE (MULTI-LINK) *
' *****************************************************************************
'
27100 AX = &H100
BX = &H2
GOSUB 60510
RETURN
'
' *****************************************************************************
' * UNLOCK USER FILE (OMNINET) *
' *****************************************************************************
'
27200 CC$ = CHR$(17) + MID$(ACTIVE.USER.FILE$ + SPACE$(8),3,8)
GOSUB 28000
IF CT = 128 THEN _
RETURN
GOSUB 50500
GOTO 27200
'
' *****************************************************************************
' * UNLOCK 4 RECORD BLOCK IN USER FILE *
' *****************************************************************************
'
27500 USER.BLOCK.LOCK = FALSE
BLK = (USER.FILE.INDEX / 4) + .26
MID$(LOCK.STATUS$,7,2) = "UB"
GOSUB 950
ON NETWORK.TYPE GOTO 27600,27700,27800
RETURN
'
' *****************************************************************************
' * UNLOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK) *
' *****************************************************************************
'
27600 AX = &H100
BX = BLK + 10
GOSUB 60510
RETURN
'
' *****************************************************************************
' * UNLOCK 4 RECORD BLOCK IN USER FILE (OMNINET) *
' *****************************************************************************
'
27700 CC$ = CHR$(17) + FN BL$
GOSUB 28000
IF CT = 128 THEN _
RETURN
GOSUB 50500
GOTO 27700
'
' *****************************************************************************
' * UNLOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET) *
' *****************************************************************************
'
27800 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + FN BL$
GOTO 25300
'
' *****************************************************************************
' * CORVUS OMNINET INTERFACE *
' *****************************************************************************
'
28000 CC$ = LINE.FEED$ + CHR$(0) + CHR$(11) + CC$
CALL CDSEND(CC$)
CALL CDRECV(CN$)
CT = ASC(MID$(CN$,3,1))
IF CT >= 128 THEN _
PRINT "CORVUS LOCK FAIL" : _
GOTO 31000
28010 CT = ASC(MID$(CN$,4,1))
IF CT >= 129 THEN _
PRINT "CORVUS FULL" : _
GOTO 31000
RETURN
'
' *****************************************************************************
' * ORCHID PC-NET INTERFACE *
' *****************************************************************************
'
28100 LOCK.DRIVE = ASC(LEFT$(ACTIVE.USER.FILE$,1))-ASC("A")
LOCK.FILE.NAME$ = LOCK.FILE.NAME$ + _
STRING$(32-LEN(LOCK.FILE.NAME$),0)
A = 0
RETURN
'
' *****************************************************************************
' * LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ *
' *****************************************************************************
'
29000 MID$(LOCK.STATUS$,10,2) = "LD"
GOSUB 950
LOCK.FILE.NAME$ = EN$
ON NETWORK.TYPE GOTO 29100,29010,22300
29010 RETURN
'
' *****************************************************************************
' * LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (MULTI-LINK) *
' *****************************************************************************
'
29100 AX = &H0
BX = &H3
GOSUB 60510
RETURN
'
' *****************************************************************************
' * UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ *
' *****************************************************************************
'
29500 MID$(LOCK.STATUS$,10,2) = "UD"
GOSUB 950
LOCK.FILE.NAME$ = EN$
ON NETWORK.TYPE GOTO 29600,29510,25300
29510 RETURN
'
' *****************************************************************************
' * UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (MULTI-LINK) *
' *****************************************************************************
'
29600 AX = &H100
BX = &H3
GOSUB 60510
RETURN
'
' *****************************************************************************
' * FLUSH MESSAGE FILE DATA TO DISK BY OPENING DUMMY FILE # 1 *
' *****************************************************************************
'
30000 CLOSE 1
IF SHARE.IT THEN _
OPEN CONFIG.FILENAME$ FOR INPUT SHARED AS #1 _
ELSE OPEN "I",1,CONFIG.FILENAME$
CLOSE 1
RETURN
'
' *****************************************************************************
' * OPEN AND DEFINE MESSAGE FILE *
' *****************************************************************************
'
30500 CLOSE 1
IF SHARE.IT THEN _
OPEN ACTIVE.MESSAGE.FILE$ FOR RANDOM SHARED AS #1 _
ELSE OPEN "R",1,ACTIVE.MESSAGE.FILE$
FIELD 1,128 AS MESSAGE.RECORD$
RETURN
'
' *****************************************************************************
' * F1 - COMMAND FROM LOCAL KEYBOARD (IMMEDIATE EXIT TO DOS) *
' *****************************************************************************
'
31000 IF MULTI.LINK.PRESENT THEN _
GOSUB 60500
SYSTEM
'
' *****************************************************************************
' * F2 - COMMAND FROM LOCAL KEYBOARD (SYSOP EXIT TO DOS AND RETURN) *
' *****************************************************************************
'
32000 IF NOT LOCAL.USER THEN _
A$="Sysop has exited to DOS. Please stand by for a few seconds." : _
GOSUB 1399 : _
GOSUB 50510
SHELL DISK.FOR.DOS$+"COMMAND"
CLS
IF NOT LOCAL.USER THEN _
GOSUB 42010 : _
GOSUB 49000 : _
A$ = "Sysop has returned from DOS. Thanks for waiting." : _
GOSUB 1400
RETURN
'
' *****************************************************************************
' * F3 - COMMAND FROM LOCAL KEYBOARD (PRINTER TOGGLE) *
' *****************************************************************************
'
33000 PRINTER = NOT PRINTER
CHANGE.VALUE = PRINTER
FIELD.POSITION = 38
GOTO 33950
'
' *****************************************************************************
' * F4 - COMMAND FROM LOCAL KEYBOARD (SYSOP ANNOY) *
' *****************************************************************************
'
33040 SYSOP.ANNOY = NOT SYSOP.ANNOY
CHANGE.VALUE = SYSOP.ANNOY
FIELD.POSITION = 34
GOTO 33950
'
' *****************************************************************************
' * F5 - COMMAND FROM LOCAL KEYBOARD (FORCE CALLER ONLINE) *
' *****************************************************************************
'
33060 RETURN 320
'
' *****************************************************************************
' * F6 - COMMAND FROM LOCAL KEYBOARD (SYSOP AVAILABLE TOGGLE) *
' * 6 - COMMAND FROM SYSOP MENU (SYSOP AVAILABLE TOGGLE) *
' *****************************************************************************
'
33070 SYSOP.AVAILABLE = NOT SYSOP.AVAILABLE
CHANGE.VALUE = SYSOP.AVAILABLE
FIELD.POSITION = 32
GOTO 33950
'
' *****************************************************************************
' * F7 - COMMAND FROM LOCAL KEYBOARD (SYSOP GETS SYSTEM NEXT) *
' *****************************************************************************
'
33090 IF ERR=61 AND NOT DISKFULL.GO.OFFLINE THEN RETURN
SYSOP.NEXT = NOT SYSOP.NEXT
CHANGE.VALUE = SYSOP.NEXT
FIELD.POSITION = 36
GOTO 33950
'
' *****************************************************************************
' * F8 - COMMAND FROM LOCAL KEYBOARD (ASSIGN USER TEMPORARY SYSOP SECURITY) *
' *****************************************************************************
'
33110 SYSOP = NOT SYSOP
CURSOR.LINE = CSRLIN
CURSOR.ROW = POS(0)
LOCATE 25,1
PRINT SPACE$(79);
LOCATE 25,1
USER.SECURITY.LEVEL = (1 + SYSOP) * _
USER.SECURITY.SAVE - _
SYSOP * _
SYSOP.SECURITY.LEVEL
PRINT "Temp SYSOP Privileges "; MID$("OFFON",1-3*SYSOP,3);
GOSUB 50510
LOCATE CURSOR.LINE,CURSOR.ROW
GOSUB 49000
RETURN
'
' *****************************************************************************
' * F9 - COMMAND FROM LOCAL KEYBOARD (SNOOP TOGGLE) *
' *****************************************************************************
'
33130 SNOOP = NOT SNOOP
IF SNOOP THEN _
LOCATE 23,1,0 : _
PRINT "SNOOP ON" : _
GOSUB 953 _
ELSE LOCATE ,,0 : _
CLS
33140 CHANGE.VALUE = SNOOP
FIELD.POSITION = 58
GOTO 33950
'
' *****************************************************************************
' * F10 - COMMAND FROM LOCAL KEYBOARD (FORCE CHAT WITH USER) *
' *****************************************************************************
'
33150 IF ACTIVE.MENU$ = "M" OR _
ACTIVE.MENU$ = "U" OR _
ACTIVE.MENU$ = "F" THEN _
GOTO 33160
CURSOR.LINE = CSRLIN
CURSOR.ROW = POS(0)
LOCATE 25,1
PRINT SPACE$(79);
LOCATE 25,1
PRINT "Cannot CHAT until user reaches MAIN menu";
GOSUB 50500
LOCATE CURSOR.LINE,CURSOR.ROW
GOSUB 49000
RETURN
33160 Z$ = "Sysop initiated chat"
GOSUB 13665
A$ = "Hi, this is " + _
SYSOP.FIRST.NAME$ + _
" " + _
SYSOP.LAST.NAME$ + _
" in CHAT mode. Sorry to break in but.."
GOSUB 1399
GOTO 4770
'
' *****************************************************************************
' * UPDATE NODE RECORD WITH LOCAL FUNCTION KEY ACTIVITY *
' *****************************************************************************
'
33950 IF SNOOP THEN _
GOSUB 49000
33960 IF CONFERENCE.MODE = FALSE THEN _
GOSUB 21990 : _
GET 1,NODE.RECORD.INDEX : _
MID$(MESSAGE.RECORD$,FIELD.POSITION,2) = STR$(CHANGE.VALUE) : _
GOTO 43080
40000 A$ = "Cannot change status during Conference!"
GOSUB 1400
RETURN
'
' *****************************************************************************
' * CALCULATE TIME REMAINING FOR USER *
' *****************************************************************************
'
41000 GOSUB 41010
IF BYPASS.TIME.CHECK THEN _
RETURN
IF TIME.REMAINING! < 0 THEN _
TIME.REMAINING! = 0 : _
RETURN 10553
RETURN
41010 TOA! = FRE("A")
IF FN TI! > USER.LOGON.TIME! THEN _
TCA! = FN TI! - USER.LOGON.TIME! _
ELSE TCA! = FN TI! + 86400!-USER.LOGON.TIME!
41020 TIME.REMAINING! = (SECONDS.PER.SESSION!-TCA!) / 60
TIME.REMAINING$ = STR$(INT(TIME.REMAINING!))
RETURN
'
' *****************************************************************************
' * DISPLAY TIME REMAINING FOR USER *
' *****************************************************************************
'
41050 GOSUB 41000
A$ = TIME.REMAINING$ + " minutes left"
GOSUB 1398
RETURN
'
' *****************************************************************************
' * SHOW USER CURRENT ACCESS LEVEL *
' *****************************************************************************
'
41070 A$ = "Granted access level" + _
STR$(USER.SECURITY.LEVEL) + _
MID$(" (SYSOP)",1,-8*(USER.SECURITY.LEVEL >= SYSOP.SECURITY.LEVEL))
GOSUB 1398
RETURN
'
' *****************************************************************************
' * CALCULATE CURRENT TIME FOR AM OR PM *
' *****************************************************************************
'
41500 TIME.LOGGED.ON$ = TIME$
CURRENT.DATE$ = LEFT$(DATE$ ,6) + RIGHT$(DATE$ ,2)
41510 TIM$ = TIME$
IF FN V(TIM$,1) = 12 THEN _
MID$(TIM$,1,2) = RIGHT$(STR$(FN V(TIM$,1)),2) : _
TIM$ = LEFT$(TIM$,5) + " PM" : _
RETURN
41520 IF FN V(TIM$,1) > 11 THEN _
MID$(TIM$,1,2) = RIGHT$(STR$(FN V(TIM$,1)-12),2) : _
TIM$ = LEFT$(TIM$,5) + " PM" : _
RETURN
TIM$ = LEFT$(TIM$,5) + " AM"
RETURN
'
' *****************************************************************************
' * TEST FOR CARRIER PRESENT (DROP CALLER IF CARRIER NOT PRESENT) *
' *****************************************************************************
'
42000 IF LOCAL.USER THEN _
RETURN
42010 IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
RETURN
'
' *****************************************************************************
' * IN CASE USER IS 2400 BAUD, PAUSE A SECOND AND CHECK AGAIN FOR CARRIER *
' * DETECT. SOME 2400 BAUD MODEMS TAKE A WHILE TO SYNCHRONIZE THE CARRIER, *
' * HENCE A ONE-SECOND BEFORE CHECKING AGAIN. *
' *****************************************************************************
'
GOSUB 50500
IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
RETURN
Z$ = "Carrier dropped"
GOSUB 13665
GOTO 10595
'
' *****************************************************************************
' * NULLS SET FOR NEW USERS *
' *****************************************************************************
'
42700 A$ = "Want nulls (Y/N)"
GOSUB 1500
IF NO OR YES THEN _
NULLS = NO _
ELSE 42700
'
' *****************************************************************************
' * N - COMMAND FROM UTILITY MENU (NULLS TOGGLE) *
' *****************************************************************************
'
42710 NULLS = NOT NULLS
GOSUB 9520
42720 A$ = "Nulls " + MID$("OffOn",1-3*NULLS,3)
GOSUB 1405
RETURN
'
' *****************************************************************************
' * F - COMMAND FROM UTILITY MENU (FILE TRANSFER DEFALUT MODE) *
' * FILE TRANSFER DEFAULT SET FOR NEW USERS *
' *****************************************************************************
'
42800 T$ = "FILE transfer default" + TRANSFER.OPTIONS$
GOSUB 21600
USER.TRANSFER.DEFAULT$ = FT$
42810 A$ = "PROTOCOL: " + MID$("Ascii MNP XmodemCRC None",6*FF-5,6)
GOSUB 1405
RETURN
'
' *****************************************************************************
' * C - COMMAND FROM UTILITY MENU (CHANGE CASE TOGGLE) *
' * UPPER/LOWER CASE SET FOR NEW USERS *
' *****************************************************************************
'
42950 A$ = "CAN YOUR TERMINAL DISPLAY LOWER CASE (Y/N)"
GOSUB 1500
IF NO OR YES THEN _
UPPER.CASE = YES _
ELSE 42950
42960 UPPER.CASE = NOT UPPER.CASE
A$ = "UPPER CASE " + MID$("and lowerONLY",1-9*UPPER.CASE,9)
GOSUB 1405
RETURN
'
' *****************************************************************************
' * G - COMMAND FROM UTILITY MENU (GRAPHICS WANTED) *
' * GRAPHIC MENUS SELECTION SET FOR NEW USERS *
' *****************************************************************************
'
43000 IF NOT EIGHT.BIT THEN _
A$ = "Graphics unavailable" : _
GOSUB 1405 : _
RETURN
43005 A$ = "GRAPHICS wanted: <N>one,<A>scii,<C>olor,<H>elp"
GOSUB 1500
IF Q = 0 THEN _
GOTO 43005
GR = INSTR("NAC",FN UC$(B$(1)))
IF GR = 0 THEN _
USER.RECORD.SAVE$ = USER.RECORD$ : _
FILE.NAME$ = HELP$(9) : _
GOSUB 1790 : _
GOSUB 9400 : _
LSET USER.RECORD$ = USER.RECORD.SAVE$ : _
GOTO 43005
USER.GRAPHIC.DEFAULT$ = MID$(" GC",GR,-(GR > 1))
GR = GR-1
43020 A$ = "GRAPHICS: " + MID$("None AsciiColor",GR*5 + 1,5)
GOSUB 1405
RETURN
43025 GOSUB 43030
GOTO 45000
43030 OK = FALSE
43031 IF GR THEN _
N$ = FILE.NAME$ : _
GOSUB 20282 : _
IF LEN(X$) < 8 THEN _
DF$ = DR$ + _
":" + _
X$ + _
USER.GRAPHIC.DEFAULT$ + _
"." + _
EXTENTION$ : _
NAME DF$ AS DF$
43032 IF OK THEN _
FILE.NAME$ = DF$
RETURN
43040 IF INSTR(3,Z$,MID$(A$,3,(LEN(A$)-2))) THEN _
RETURN 20245
RETURN
'
' *****************************************************************************
' * UPDATE CALLERS FILE AT LOGOFF *
' *****************************************************************************
'
43050 FIELD 4,55 AS CALLERS.RECORD$,3 AS HOURS$,3 AS MINUTES$,3 AS SECONDS$ 'CPC131A7
LSET CALLERS.RECORD$ = MID$(NG$,65,55)
LSET HOURS$ = STR$(HHH)
LSET MINUTES$ = STR$(MMM)
LSET SECONDS$ = STR$(SSS)
CALLERS.FILE.INDEX = CALLERS.FILE.INDEX + 1
PUT 4,CALLERS.FILE.INDEX
FIELD 4,64 AS CALLERS.RECORD$
LSET CALLERS.RECORD$ = LEFT$(NG$,64)
CALLERS.FILE.INDEX = CALLERS.FILE.INDEX + 1
PUT 4,CALLERS.FILE.INDEX
43060 LSET CALLERS.RECORD$ = STRING$(64,CHR$(0))
PUT 4
PUT 4
IF FIRST.NAME$ = SYSOP.FIRST.NAME$ AND _
LAST.NAME$ = SYSOP.LAST.NAME$ THEN _
SYSOP = TRUE _
ELSE SYSOP = FALSE
'
' *****************************************************************************
' * SAVE USER PROFILE WHEN EXITING *
' *****************************************************************************
'
43070 GOSUB 21990
GET 1,NODE.RECORD.INDEX
MID$(MESSAGE.RECORD$,40,2) = STR$(EXIT.TO.DOORS)
MID$(MESSAGE.RECORD$,42,2) = STR$(EIGHT.BIT)
MID$(MESSAGE.RECORD$,44,2) = STR$(BPS)
MID$(MESSAGE.RECORD$,46,2) = STR$(UPPER.CASE)
MID$(MESSAGE.RECORD$,48,5) = SPACE$(5)
KG = TRUE
GOSUB 41010
MID$(MESSAGE.RECORD$,48,5) = STR$(TIME.REMAINING!)
MID$(MESSAGE.RECORD$,53,2) = STR$(GR)
MID$(MESSAGE.RECORD$,55,2) = STR$(SYSOP)
43080 PUT 1,NODE.RECORD.INDEX
GOSUB 21996
GOSUB 30500
RETURN
'
' *****************************************************************************
' * RESTORE USER PROFILE WHEN RETURNING FROM DOORS *
' *****************************************************************************
'
44000 GET 1,NODE.RECORD.INDEX
EIGHT.BIT = FN V(MESSAGE.RECORD$,42)
BPS = FN V(MESSAGE.RECORD$,44)
UPPER.CASE = FN V(MESSAGE.RECORD$,46)
MINUTES.PER.SESSION! = VAL(MID$(MESSAGE.RECORD$,48,5))
GR = FN V(MESSAGE.RECORD$,53)
SYSOP = FN V(MESSAGE.RECORD$,55)
IF BPS = -1 THEN _
BAUD.RATE.DIVISOR = &H180:' 300 BAUD
IF BPS = -2 THEN _
BAUD.RATE.DIVISOR = &H100:' 450 BAUD
44005 IF BPS = -3 THEN _
BAUD.RATE.DIVISOR = &H60:' 1200 BAUD
IF BPS = -4 THEN _
BAUD.RATE.DIVISOR = &H30:' 2400 BAUD
44010 GOSUB 1654
USER.LOGON.TIME! = FN TI!
IF MINUTES.PER.SESSION! < 1 THEN _
MINUTES.PER.SESSION! = 3
44015 IF NOT EIGHT.BIT THEN _
OUT LINE.CONTROL.REGISTER,&H1A
44020 IF SYSOP THEN _
FIRST.NAME$ = SYSOP.PASSWORD.1$ : _
LAST.NAME$ = SYSOP.PASSWORD.2$ : _
RETURN
44030 FIRST.NAME.END = INSTR(MESSAGE.RECORD$," ")
LAST.NAME.END = INSTR(FIRST.NAME.END + 1,MESSAGE.RECORD$," ")
FIRST.NAME$ = LEFT$(MESSAGE.RECORD$,FIRST.NAME.END-1)
LAST.NAME$ = MID$(MESSAGE.RECORD$,FIRST.NAME.END + 1,LAST.NAME.END-(FIRST.NAME.END + 1))
GOSUB 12550
RETURN
'
' *****************************************************************************
' * DISPLAY NON-BREAKABLE TEXT FILES *
' *****************************************************************************
'
45000 STOP.INTERRUPTS = FALSE
GOSUB 6000
STOP.INTERRUPTS = TRUE
RETURN
'
' *****************************************************************************
' * MAKE INPUT STRING HIDDEN (USE *'S TO ECHO INPUT) *
' *****************************************************************************
'
45010 HIDDEN = TRUE
GOSUB 1500
HIDDEN = FALSE
GOSUB 1405
RETURN
'
' *****************************************************************************
' * XMODEM / CRC INTERFACE *
' *****************************************************************************
'
46000 XMODEM.CHECKSUM = 0
CRC.VALUE = 0
CALL XMODEM(WK$,XMODEM.CHECKSUM,CRC.VALUE,CRC.HIGH,CRC.LOW)
RETURN
'
' *****************************************************************************
' * BUILD LINE 25 DISPLAY *
' *****************************************************************************
'
49000 LINE.25$ = MID$(" AVL ",1-4*SYSOP.AVAILABLE,4) + _
MID$(" ANY ",1-4*SYSOP.ANNOY,4) + _
MID$(" LPT ",1-4*PRINTER,4) + _
MID$("SYS",1,-3*SYSOP.NEXT)
GOSUB 950
RETURN
'
' *****************************************************************************
' * DISPLAY MESSAGE & COMMENT EDIT PROMPT LINE *
' *****************************************************************************
'
50400 A$ = "A)bort, C)ontinue, D)elete, E)dit, I)nsert, L)ist, M)argin, S)ave"
GOSUB 1398
RETURN
'
' *****************************************************************************
' * 1 SECOND DELAY *
' *****************************************************************************
'
50500 DELAY! = FN TI! + 1
GOTO 50520
'
' *****************************************************************************
' * 3 SECOND DELAY *
' *****************************************************************************
'
50510 DELAY! = FN TI! + 3
50520 IF FN TI! < DELAY! AND _
DELAY! < 86400! THEN _
GOTO 50520
RETURN
'
' *****************************************************************************
' * UPDATE DOWNLOAD STATISTICS *
' *****************************************************************************
'
50600 IF DOWNLOAD.COMPLETED THEN _
DOWNLOADS = DOWNLOADS + 1 : _
Y$ = " Downloaded " _
ELSE Y$ = " Aborted "
50610 IF LOCAL.USER THEN _
RETURN
GOSUB 41510
Z$ = FILE.NAME$ + Y$ + "at " + TIM$ + " using " + FT$
GOSUB 13670
IF LEFT$(B$(1),1) = "/" THEN _
Z$ = + " file desc: " + B$(1) : _
GOSUB 13670
RETURN
'
' *****************************************************************************
' * GET FREE SPACE ON DISK *
' *****************************************************************************
'
52000 CLS
52001 FILES Z$
FREE.SPACE$ = ""
FOR X = 1 TO 25
FREE.SPACE$ = FREE.SPACE$ + CHR$(SCREEN (3,X))
NEXT
GOSUB 49000
RETURN
'
' *****************************************************************************
' * SEND MODEM COMMAND *
' *****************************************************************************
'
52070 IF DUMB.MODEM THEN _
RETURN
IF COMMANDS.BETWEEN.RINGS THEN _
WHILE(INP(MODEM.STATUS.REGISTER) AND &H40) : _
WEND
52075 GOSUB 50500
PRINT #3,A$
RETURN
'
' *****************************************************************************
' * DIRECTORY SEARCH *
' *****************************************************************************
'
52900 CK = 2
IF Q > 1 THEN _
GOTO 52920
52910 A$ = "Search for string (Press [ENTER] to quit)"
GOSUB 1500
IF Q = 0 THEN _
RETURN
B$(2) = B$(1)
52920 RS$ = FN UC$(B$(2))
A1$ = B$(2)
GOTO 53007
'
' *****************************************************************************
' * N - COMMAND FROM FILES MENU (DISPLAY NEW FILES SINCE LAST DIR DISPLAY) *
' *****************************************************************************
'
53000 CK = 1
IF Q > 1 THEN _
GOTO 53005
53002 A1$ = RIGHT$(LM$,4) + LEFT$(LM$,2)
A$ = "Include files on/after (MMDDYY, [ENTER] = last date on " + A1$ + ")"
GOSUB 1500
IF Q = 0 THEN _
RS$ = LM$ : _
GOTO 53007
B$(2) = B$(1)
53005 IF LEN(B$(2)) <> 6 THEN _
GOTO 53002
A1$ = B$(2)
RS$ = RIGHT$(A1$,2) + LEFT$(A1$,4)
53007 IF Q > 2 THEN _
B$(2) = B$(3) : _
GOTO 53030
53010 A$ = "Directory to scan or ALL"
GOSUB 1500
IF Q = 0 THEN _
RETURN
B$(2) = B$(1)
53030 Q = 2
LIST.DIRECTORY = TRUE
LIST.NEW = TRUE
Z$ = FN UC$(B$(2))
IF Z$ = "ALL" THEN _
GOTO 53070
53060 GOSUB 20160
LIST.NEW = FALSE
RETURN
53070 G = 2
J = 2
FOR SUBDIR.INDEX = 1 TO SUBDIR.COUNT + (NOT SYSOP)
B$(2) = SUBDIR$(SUBDIR.INDEX) + _
"*." + _
DIRECTORY.EXTENTION$
GOSUB 10720
CLS
NEXT
GOSUB 49000
QX = G
X = 3
GOSUB 20161
LIST.NEW = FALSE
RETURN
'
' *****************************************************************************
' * OPEN AND DEFINE CALLERS FILE *
' *****************************************************************************
'
56000 CLOSE 4
OPEN "R",4,CALLERS.FILE$,64
FIELD 4,64 AS CALLERS.RECORD$
RETURN
'
' *****************************************************************************
' * DISPLAY CALLERS FILE *
' *****************************************************************************
'
57000 GOSUB 1485
CALLERS.FILE.INDEX.TEMP = CALLERS.FILE.INDEX
57005 IF CALLERS.FILE.INDEX.TEMP < 1 OR _
RET THEN _
RETURN
57010 GET 4,CALLERS.FILE.INDEX.TEMP
A$ = CALLERS.RECORD$
IF LEFT$(A$,3) = SPACE$(3) OR _
INSTR(A$,"on at") = 0 THEN _
GOTO 57030
57025 CALLERS.FILE.INDEX.TEMP = CALLERS.FILE.INDEX.TEMP -1
GET 4,CALLERS.FILE.INDEX.TEMP
A1$ = LEFT$(CALLERS.RECORD$,15)
IF SYSOP OR _
LEFT$(A1$,3) <> SPACE$(3) THEN _
A$ = A$ + A1$
57027 GOSUB 57100
GOTO 57045
57030 IF SYSOP THEN _
GOSUB 57100
57045 CALLERS.FILE.INDEX.TEMP = CALLERS.FILE.INDEX.TEMP -1
GOTO 57005
57100 GOSUB 1405
57110 IF PAGE.LENGTH AND _
Q >= 0 THEN _
Q = Q + 1 : _
IF Q >= PAGE.LENGTH THEN _
GOSUB 5600 : _
IF NO THEN _
RETURN 57120 _
ELSE Q = 0
57120 RETURN
'
' *****************************************************************************
' * OPEN RBBS-PC'S "WORK FILE" (I.E. FILE NUMBER 2) FOR INPUT. OPEN IT AS *
' * "SHARED" IF MULTIPLE COPIES OF RBBS-PC WILL BE RUNNING UNDER THE SAME DOS *
' *****************************************************************************
'
58000 CLOSE 2
58010 BADNEWS=0
58020 IF SHARE.IT THEN _
OPEN FILE.NAME$ FOR INPUT SHARED AS #2 _
ELSE OPEN FILE.NAME$ FOR INPUT AS #2
58030 RETURN
'
' *****************************************************************************
' * TEST FOR FUNCTION KEY PRESSED *
' *****************************************************************************
'
60000 KEY.PRESSED$ = INKEY$
IF LEN(KEY.PRESSED$) <> 2 THEN _
RETURN
60010 KEY.PRESSED = ASC(RIGHT$(KEY.PRESSED$,1))
IF KEY.PRESSED < F1.KEY OR _
KEY.PRESSED > F10.KEY THEN _
RETURN
FUNCTION.KEY = KEY.PRESSED - 58
ON FUNCTION.KEY GOSUB 31000, _ ' F1
32000, _ ' F2
33000, _ ' F3
33040, _ ' F4
33060, _ ' F5
33070, _ ' F6
33090, _ ' F7
33110, _ ' F8
33130, _ ' F9
33150 ' F10
RETURN
'
' *****************************************************************************
' * MULTI-LINK DEQUEUE COM PORT *
' *****************************************************************************
'
60500 AX = &H100
60505 BX = -4
IF COM.PORT$ = "COM2" THEN _
BX = -3
'
' *****************************************************************************
' * MULTI-LINK INTERFACE *
' *****************************************************************************
'
60510 CALL RBBSML(AX,BX)
RETURN
'
' *****************************************************************************
' * REPLY TO MESSAGE SAVE ORIGINAL ATTRIBUTES *
' *****************************************************************************
'
62520 SQ = Q
LG$(10) = B$
LINES.IN.MESSAGE.SAVE = LINES.IN.MESSAGE
SL = S
NON.STOP.SAVE = NON.STOP
MESSAGE.DIM.INDEX.SAVE = MESSAGE.DIM.INDEX
RETURN
'
' *****************************************************************************
' * REPLY TO MESSAGE RESTORE ORIGINAL ATTRIBUTES *
' *****************************************************************************
'
62530 Q = SQ
B$ = LG$(10)
LINES.IN.MESSAGE = LINES.IN.MESSAGE.SAVE
S = SL
NON.STOP = NON.STOP.SAVE
MESSAGE.DIM.INDEX = MESSAGE.DIM.INDEX.SAVE
KILL.MESSAGE = FALSE
RETURN